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KALMAN  FILTER 

TIME  SERIES  ANALYSIS  OF  GAMMA-RAY  DATA 
FROM  Nal(Tl)  DETECTORS  FOR  THE  ND6620  COMPUTER 

in  rKuuucnoN 

This  program  is  intended  for  use  on  time  series  gamma-ray  data  from 

Nal(n)  detectors-  It  is  used  in  conjunction  with  the  PAGSCN  Data  Screen^ 
and  tne  PREGA  Regression  Analysis^  programs.  The  data  consists  of 
consecutive  256  channel  gamma-ray  spectra,  each  collected  over  a  unit  time 
period.  Program  PAGSCN  screens  the  data  for  bad  records  and  system 

malfunctions.  The  data  are  then  summed  over  time  into  background  and  source 
spectra.  Program  PKEGA  is  used  to  do  a  pivotal  regression  analysis  of  the 
source  spectrum  to  a  library  consisting  of  the  background  plus  a  set  of 
standard  spectra.  PKEGA  determines  the  subset  of  the  library  which  gives 
the  Dest  fit  to  the  source  spectra  in  tne  least-squares  sense.  The  Kalman 
Filter  is  then  used  to  determine  the  time  Dehavior  for  the  intensities  of 
tne  liorary  spectra  as  components  of  the  source  spectrum. 

PREPARATION  FOR  KALMAN  FILTER 

The  analyst  should  be  guided  by  the  results  of  the  PREGA  least-squares 
analysis  in  selecting  library  sources  for  use  in  the  Kalman  Filter.  In 
general,  trie  background  plus  the  sources  found  to  be  significant  in  the 

least-squares  analysis  will  be  used.  Additional  library  sources  may  be 
included  to  check  for  possible  interferences  or  correlations  with  the  data. 
Tne  gain  and  zero  offset  of  tne  library  spectra  must  be  adjusted  using 

Program  GSHIFT2  to  match  tne  values  obtained  from  the  energy  calibration 
of  the  background.  It  is  assumed  that  these  values  do  not  change  between 
collection  of  the  background  and  the  source  spectra. 

THEORY  OF  OPERATION 

The  Kalman  filterl>2  provides  an  adaptive  minimum  variance  estimate  of 
the  intensities  of  the  various  library  spectra  in  the  source  spectrum  at 
each  10  second  record.  It  makes  optimal  use  of  a  priori  data  from  the 
results  of  the  previous  measurements  and  comDines  this  with  the  current 
results  to  get  a  best  estimate  for  the  source  intensities  xk  at  time  k  and 
tneir  covariances  P|<,  given  the  observed  spectra  yi,  y2,  ...»  yk- 

The  filter  operates  on  a  system  model  snown  in  Fig.  1  which  relates  the 
source  intensities  Xk  at  time  k  to  the  observed  data  yk.  The  response 
matrix  5k  describes  the  response  of  the  detector  system  to  the  signal  from 
the  source.  The  expected  output  of  the  system  is  SkXk.  Added  to  this 
is  a  system  noise  vector  vk  which  includes  the  random  statistical 
variations  in  the  detector  system.  Tne  result  is  the  observed  system  output 
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y«.  Generally  toe  system  noise  v)<  is  assumed  to  be  gauss i an  witn  a  mean 
of  zero  and  covariance  RK  wnich  is  known  or  can  oe  estimated. 


Tne  oehavior  of  the  source  between  times  k  and  k+1  is  assumed  known  and 
is  modeled  oy  tne  transition  matrix  H|<.  Tne  expected  output  is  H^x^. 
Added  to  tnis  is  tne  input  noise  vector  Uj<  which  represents  variations  in 
tne  source  intensities  due  to  unknown  effects  or  inadequacies  in  tne  model. 
Tne  result  is  tne  vector  x<+]  giving  tne  source  intensities  at  time  k+1. 
Tne  input  noise  is  also  generally  assumed  to  be  gaussian  with  zero  mean  and 
covariance  Qk  which  is  known  or  can  be  estimated.  Note  that  the  input 
noise  u«  drives  the  system,  whicn  is  otherwise  completely  determined  by 
tne  initial  conditions  xq  and  the  transmission  matrices 
Ho, hi, . . . ,H|<.  Were  it  not  for  the  input  noise,  our  knowledge  of  the 
source  vector  X|<  would  continue  to  improve  with  each  observation,  and  its 
covariance  Pj<  would  continued  to  decrease. 


Given  tne  above  model,  the  Kalman  filter  shown  in  fig.  2  provides 


x. 


k/k-1 
/\ 


and  covariance  P 


k/k-1 


and 


estimates  for  the  source  intensities 

for  the  expected  system  output  y^  =  S^.  These  are  compared  to  the 

observed  data  y  .  The  difference  between  observation  and  prediction  is 
<> 

feo  oacx  witn  a  gain  Kfc  to  provide  a  corrected  estimate  given  by 


xk/k  =  xk/k-1  +  Kkiyk  -  ykJ* 


Tne  magnitude  of  the  Kalman  gain  K i<  depends  on  both  the  input  covariance 
P^/k-I  and  tne  output  covariance  R|<* 

Mt  cime  step  k,  we  begin  with  a  priori  estimates  represented  by  $k/k-l 
and  fx/k-1  based  on  data  up  to  and  including  yk-1*  The  updated  a 
posteriori  estimates,  including  the  Knowledge  of  the  data  y^,  are  then 
given  by 

xk/k  *  E1  KkSJxk/k-l  +  Kkyk 
Px/k  =  E1  '  KkSJPk/k-l 

where  I  is  tne  diagonal  identity  matrix,  and  the  Kalman  gain 


K,  =  P,  ,,  ,  S  r[S.  P.  ,  S.  T+  R,  ]’ 
k  k/k-1  k  L  k  k/k-1  k  kJ 


where  RK  is  the  diagonal  matrix  given  by  the  Poisson  variances  in  the  data 
yk- 


The  response  matrix  6k  is  made  up  of  elements  S|<(I,J)  giving  the 
response  of  the  detector  system  in  channel  I  to  a  unit  source  of  type  J. 
The  columns  of  $k  thus  contain  the  library  spectra,  and  the  elements 
$k(J)  contain  the  estimated  intensities  of  source  J  at  time  k.  We  will 
assume  tnat  the  system  response  does  not  change  with  time  so  that  Sk  is  a 
constant  matrix  for  all  times  k. 

Tc  obtain  a  priori  estimates  at  time  <+l,  we  can  write 

a  ,,  A 

X,  ,,  =  rl.  X.  . 

k+i/k  k  k  /  k 

PK*l/k  ’  Hk  PK/K  % 


The  transition  matrix  Hk  represents  the  known  time  behavior  of  the  system, 
which  we  will  take  as  constant  so  that  Hk  =  I,  the  identity  matrix.  The 
input  noise  matrix  Qj< ,  which  we  will  take  as  diagonal,  represents  modeling 
errors  ana  other  unknown  variations  in  the  source  term  xk.  We  will  take 
it  to  be  proportional  to  the  square  of  a  weighted  mean  xk  for  times 
1,2. . .  ,k 


gk(I,J)  =  «jj  qQ(J)  xk(J)2 

or  optionally,  fix  it  at  its  value  at  some  time  kO, 


Qk  =  Qk0  for  k  2  kO. 


Currently  we  use  qo(J)  =  0.1  for  background  and  0.3  for  the  rest  of  the 
library. 


For  a  constant  background  and  small  input  noise,  the  system  will  rapidly 
approach  good  estimates  for  x  and  P,  regardless  of  the  chosen  initial  values 
of  xq  and  Pg.  If  the  signal  then  changes  due  to  a  real  source,  it  will 
take  several  time  steps  to  obtain  good  estimates  for  the  new  values  of  x  ana 
P.  The  magnitude  of  the  input  noise  term  Q  relative  to  the  output  noise  R 
determines  how  fast  the  filter  can  adjust  to  a  change  in  the  signal.  A 
small  Q  leads  to  greater  memory  and  thus  smoother  variations  in  the 
estimates  x.  A  large  Q  leads  to  less  memory  resulting  in  a  more  immediate 
influence  of  a  cnange  in  the  observed  data  y  and  thus  larger  variations  in 
the  estimates  x.  This  is  discussed  in  more  detail  below  in  the  section  on 
"Fi Iter  Tuning ." 


To  start  the  filter  we  use  initial  values  xq/_i  of  1.0  for  background 
and  equal  to  their  estimated  standard  deviations  for  the  other  library 
members.  We  assume  an  initial  error  of  100  percent  so  that  the  initial 
variance  is 
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0/-1 


(I,J) 


6IJ 


A 

X0/-l 


(J)2 


1 


.1 


3 


A  '  ^ 1  ^ 


To  obtain  output  intensities  in  terms  of  standard  deviation  units,  we 
calculate  a  normalized  source  term 


nk s  (Jk/k  -  x'k)/vkl/2 


wnere  tne  weighted  mean  uses  an  iterative  exponential  weighting  with 
constant  slope,  a,  given  by 


\  =  <\  Vi  +  xk/k)/bk 


where  the  constant  in  the  numerator 


k-1 


■E 

j-o 


ak  =  >  a 


(k-j) 


In  tne  denominator 


“k =  \ + 1 


rv 

E 

j=o 


,(k-j) 


so  that  a^+i  =  a  b|<.  The  numerator  is  equivalent  to 


k 


E 

•i=n 


a(k-j); 


j/j 


so  for  the  constant  slope,  a,  less  than  one  we  have  exponentially  declining 
weights  as  we  go  back  in  time,  for  large  k  we  approach  the  limits 


1 im  a^  =  a/( 1-a) 

K  -*■00 


1  im  b|<  *  l/( 1-a) . 


An  exponential ly  weighted  variance,  vk  is  also  calculated  for  xk/kj  by 


5k  =  ‘Vk-l  *  Xk/<2)/bk 


vk  =  5k  - 


r'iL.T£,-<  TUNING 


To  rurtner  examine  the  effects  of  the  parameters  q0,  consider  the 
terms  in  tne  brackets  for  the  expression  for  the  Kalman  gain 


Kk  =  Pk/<-l  Sk  ^k  Pk/k- 1  Sk  +  V  ' 


for  tne  output  noise  Kk  negligibly  small,  we  note  that 


Kk  -  V 


A  -  -1 

Xk/k^Sk  *k 


In  tnis  limit,  che  updatea  estimates  depend  only  on  the  response  matrix  sk 
and  tne  ooserveo  data  yi<  at  step  k.  All  information  prior  to  step  k  is 
ignored. 

for  negligibly  small  input  noise,  Pk/k-1  becomes  negligibly  small  and 
tne  first  term  in  the  brackets  can  be  neglected.  Then 


Pk/k-l  Sk  Rk 


</k  ~  k/k- 1 

In  tnis  limit,  tne  updated  estimates  depend  only  on  the  a  priori  estimates 
and  tne  observed  oata  yk  is  ignored.  The  filter  will  tend  to  diverge  from 
tne  uata  over  time. 

Tne  input  covariance  estimate  Pk/k-l  15  kept  from  becoming  negligibly 
small  Dy  tne  addition  of  the  input  noise  matrix  Qk  at  eacn  time  step. 
fnus  the  filter  is  driven  by  the  input  noise.  If  Q  is  too  small,  the 
estimates  will  tend  to  diverge  from  the  data.  If  Q  is  too  large,  they  will 
depend  only  on  tne  last  observation,  ignoring  all  previous  data.  Tne  values 
of  q0  recommended  in  the  previous  section  can  be  decreased  or  increased 


dependinn  on  the  amount  of  smoothing  desired  in  the  estimates  as  they  vary 
with  time. 


RROGRrtM  KLPKhP 


Operation 

This  program  reads  tne  data  tapes,  extracts  the  gamma  spectra,  record 
ID,  and  MODE,  condenses  tne  gamma  spectra  from  256  to  a  fewer  nurriDer  of 
channels  (typically  sixteen)  and  writes  the  results  to  a  disk  file  for  use 
oy  the  Kalman  filter. 


Language 

The  program  is  written  in  DEC  RT -11  FORTRAN  and  runs  on  the  Nuclear  Data 
ND6620  computer  under  the  MIDAS  operating  system. 


Inputs 

Magtape  data  files  in  NIAGARA  format 

Keyooard  logical  unit  ( LU )  5,  input  in  ASCII  separated  by  blames 

or  commas. 


Outputs 

OisKtile  LU12,  header  and  condensed  spectra  in  format  for  input 

to  program  KFILTR 

Lineprinter  LU6,  header  and  condensed  spectra  in  ASCII  format.  For 
diagnostic  purposes,  not  normally  printed  out,  sample 
output  in  Appendix  A. 


SuDroutines  Called 

FkEEFM  free  field  input  routine  (FORTRAN  listing  in  Appendix  B) 

MCLI  utility  to  allow  call  of  MIDAS  system  command  from 

program  (see  Appendix  C).  Used  to  define  LU12  as 
desired  diskf i le. 


OANUC 
UA  r  I N 


MTaPEF 


utility  to  open  diskfile  on  LU 1 2  (see  Appendix  C) 

reaos  in  data  from  the  tapes  (FORTRAN  listing  in 
Appendix  B) 

tape  input  utility  (see  Appendix  C) 


6 


1  "V*  ■V  'V  ’ 


-J  •  TJ  — r* 


8TIHE 

utility  to  return  day  and  date  in  integer  format  (see 
Appendix  C) 

DATUUr 

outputs  data  to  LU12  (FORTRAN  listing  in  Appendix  B) 

Input  Variables 

”  •. 

Record  1 

NF3KIP 

number  of  files  on  tape  to  skip  before  beginning 
processing 

• 

NRSKIP 

number  of  records  on  tape  to  skip  before  beginning 
processing 

iNREC  1 

10  of  first  data  record  to  process 

• 

HREC2 

ID  of  last  data  record  to  process 

Record  2a, . . . 

• 

NUt<£C(I ) 

up  to  16  bad  records  to  delete,  entered  on  one  or  more 
lines,  separated  by  commas,  terminated  by  double 
carriage  return 

Record  3 

« 

• 

MS 

starting  channel  in  input  spectrum 

MF 

final  channel  in  input  spectrum 

• 

NCH 

number  of  channels  in  condensed  output  spectrum.  Eacn 
cnannel  in  the  output  spectrum  will  contain  N  input 
channels  starting  with  MS  and  ending  with  MF,  where  N  = 

(MS  -  MF  +  NCH)/NCH. 

• 

Record  4 

FILE. ELEMENT 

filename  for  output  on  LU12 

• 

Kecord  5 

I  hNS 

ASCII  'YES'  or  'NO1  in  answer  to  whether  to  printout 
results  on  LU6 

• 

7 


lutput  variaDles 


leaaer 

HtMUtK ( I ) 
inritCl,  NR2C2 

i'iTIivl£ 

NCH 
MS,  HE 

L)ata  Records 

iN  PEC 
NID 
I1(D 
I£(D 


neaaer  recora 

first  ana  last  output  record 

total  time  spanned  by  data  (seconds) 

number  of  channels  in  output  spectrum 
starting  and  final  channels  in  input  spectrum 


record  ID  number 
MODE  switch 

output  spectrum  for  Pod  1 
output  spectrum  for  Pod  2 
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Appendix  A:  Sample  Outputs  for  file  J0161 


1.  Printer  fi le 

2.  Disk  fi le 

3.  Plot  (fig.  Al) 


lineprinter  output  (LU6)  from  KfllTR 
normalized  intensities  (LU3)  from  KFILTR 
plot  of  normalized  intensity  estimates 
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LISIN  inputs  library  spectra  from  logical  unit  LUF,  number  of 

channels  M 

Output  from  KOUT 

Lineprinter  LU6,  lineprinter  output,  input  information,  header,  and 
results 

Disk  File  LU3,  normalized  intensities 

Lineprinter  Output  Columns 

RFC  record  number 

MODE  data  MODE  switch 

XSQ1,  XSQ2  normalized  chi-square  (RSS)  for  pods  1  and  2 

Library  Elements  relative  intensities  for  pod  1  followed  by  pod  2. 

Disk  File  Output  Columns 

REC,  MODE  same  as  above 

Library  Elements  normalized  intensities  for  pod  1  followed  by  pod  2. 
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dimension  of  Q  on  call  to  DDKALM 
error  indicator  from  DDKALM 
DO  loop  indices 


IER 
I,J 

Inpuc  to  KlIN 

Keyooara  L05,  on  initial  call  only,  free  field  format  separated  Dy 

commas 

Data  file  LU12,  contains  output  from  KLPREP 

Input  Variables  from  Keyboard 
Record  1 

file. Element  file  name  for  output  of  KLPREP 

LREC1,  LREC2  optional  start/stop  records,  defaults  from  KLPREP 

IQ1,  IQ2  optional  cutoff  records  kQ  for  calculation  of  Q,  xm, 

and  s,  pods  1  and  2 

Records  2a, . . . 

NDREC(I)  optional  bad  record  numbers  to  delete  during  calculation 

Input  to  KINIT 

Keyboard  LU5,  free  field  format  separated  by  commas 

Disk  file  LU8,  library  spectra  in  Nuclear  Data  spectral  format 

Input  Variables  from  Keyboard 

Records  3a,  ...  library  spectra  for  Pod  1,  Pod  2 

file. Element  filename  for  spectrum 

REALX(l)  counting  time  for  spectrum 

RtALX{2)  initial  intensity,  xy/_i 

RE ALX(3)  optional  fractional  error,  (qo)1/2,  default  =  1.0 

Subroutines  Called  by  KlrtlT 

free  field  input  subroutine  (listing  in  Appendix  B) 


PRtEfM 


V118.8), 

V2(8,8) 

Yl(lb), 

y2 ( 16) 

81(16), 

82(16) 

ri(i6,id), 

T2 (16,1b) 

T3(16) 

61(16,8), 
S2( 16,8) 


input  noise  vector,  diagonal  elements  of  input  noise 
matrix  Q 

covariance  matrices  P  for  pods  1  and  2 


input  data  spectra  for  pods  1  and  2 


Poisson  variances  for  pods  1  and  2 


work  arrays  for  DDKALM 


work  vector  for  DDKALM 

library  response  matrices  for  pods  1  and  2 


Q 1 ( 8 ) ,  Q2(8)  vectors  of  input  noise  factor  q0  for  pods  1  and  2 


Pl(8),  P2(8) 


IN,  IL,  IS, 
IT 


vector  of  diagonal  elements  of  covariance  matrix  P  for 
pods  1  and  2 

step  index  for  Kalman  filter,  increments  by  one  each  for 
record 

dimensions  for  arrays  used  in  DDKALM 


record  number 


logical  unit  number  for  CRT 

logical  unit  number  for  line  printer 

initially  0,  set  to  1  after  call  to  KINIT 

MODE  switch  for  input  data 

number  of  channels  for  condensed  data 


Nl,  N2 

IDAY,  IYR 

I  HR,  IMIN, 
I  SEC 


starting  channel  for  256  channel  spectra 
final  channel  for  256  channel  spectra 
numoer  of  library  elements  for  pods  1  and  2 
Julian  date,  year 
hour  of  day,  minute,  second 


II 


.H  H  JWl  I 


The  cutoff  record  K1  is  the  minimum  of  KO,  input  by  the  operator,  or  the 
last  record  of  the  initial  block  of  background  (MODE  =  1)  data.  There 
should  be  at  least  30  ocords  of  MODE  =  1  at  the  beginning  of  the  data  in 
order  to  get  a  good  value  for  the  sample  mean  xm  and  standard  deviation  s. 

The  normalized  intensities  n(x)  are  output  to  a  disk  file  on  LU3.  The 
intensities  are  listed  in  the  printout  on  LU 6  and  are  flagged  by  an 

asterisk  whenever  n(x)  or  one  of  the  three  exponentially  weighted  averages 
exceeds  its  standard  deviation  by  a  factor  THSIG  currently  set  at  2.0 
sigma.  Sample  outputs  and  plots  of  are  given  for  collection  JQ039  in 

appendix  A. 


Language 


The  program  is  written  in  DEC  RT11  FORTRAN  and  runs  on  the  Nuclear  Data 
NU6620  computer  under  the  MIDAS  operating  system. 


Inputs 

Data  input  by  KLIN.  Library  spectra  input  by  KINIT. 


r  • 

[•  Outputs 

[-  Data  output  by  KOUT.  Running  status  output  to  CRT  (LU5) .  .v 


is  Suoroutines  Called  f 


KLIN 

inputs  data  from  disk  file  on  LU12.  (output  of  KLPREP). 
Listing  in  Appendix  8. 

•*v* 

if 

KINIT 

inputs  library  spectra  from  LU8, 
channels  used  for  data  from  KLPREP. 

condenses  to  number  of 
Listing  in  Appendix  8. 

1*..  . 

• 

t 

BTIME 

utility  to  return  day  and  date 
Appendix  C). 

in  integer  format  (see 

• 

KSTEP 

calculates  the  diagonal  elements 
matrix  Q. 

for  the  input  noise 

i 

DDKALM 

computes  the  updated  estimates  x^/k 

and  Pk/k  * 

KOUT 

outputs  the  results. 

• 

» 

Vari ables 

* 

* 

XI (8) ,  X2(8) 

vector  of  estimated  source  intensities  x  for  pods  1  and  2 

• 

r 

H(8) 

source  transition  vector,  diagonal 
matrix  H 

elements  of  transition 

i 
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PROGRAM  KFILTR 


Operation 

Tnis  is  the  main  Kalman  filter  program.  It  calls  suoroutines  KLIN  to 
read  in  the  data  from  tne  file  prepared  by  KLPREP,  KINIT  to  read  in  the 
liorary  spectra  and  condense  tnein  to  the  same  numoer  of  channels  as  the 
data,  KSTEP  to  prepare  for  analyzing  the  next  record,  OOKALM  to  do  the 
Kalman  filter  equations,  and  KOUT  to  output  tne  results  of  each  record. 
Sample  output  and  plots  are  given  in  Appendix  A  for  collection  J0039. 

Tne  Kalman  filter  subroutine  ODKALM  is  a  modification  of  a  proprietary 
suoroutine  fTKALM,  copywrited  by  International  Mathematical  and  Statistical 
Library,  Inc.  (IMSL).  It  in  turn  calls  a  numoer  of  proprietary  IMSL 
routines.  Listings  are  given  in  Appendix  D  for  illustrative  purposes  only. 

The  lineprinter  output  gives  for  each  Pod  the  normalized  chi  square  or 
residual  sum  of  squares  (RSS) 

(1/NO)  z  (skxk/k-l  -  yk)2/yk 
I 

for  each  record  k  with  NO  degrees  of  freedom  and  Poisson  date  yk,  where 
tne  sum  is  over  the  channels  I  in  the  data  spectrum.  If  this  exceeds  a 
threshold  THRESH  currently  set  at  3.0  sigma,  the  value  is  flagged  by  an 
asterisk.  Source  intensities  are  given  for  each  library  member  and  for  each 
pod.  Exponentially  weighted  averages  are  calculated  for  each  library  source 
for  three  different  slopes. 


t\ 


a  =  0.95,  0.80,  and  0.667. 


A  normalized  intensity,  n(x),  is  also  calculated,  by 

n(x)  =  (xk/k  -  xm)/s 


where  the  sample  mean  xm  and  standard  deviation  s  are  given  for  k  <  kl  by 


xm  =  xk 
s  =  ( vk) 1/2 


and  for  K  >  Kl  by 

xm  =  xkl 
s  =  (vkl)1/2. 
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1  5 . 957E- 

-02 

-0.307 

3.65 

-1.55 

0.570 

-1.95 

2.07 

0.582 

527 

1  -0.396 

-0.702 

3.34 

0.  147 

-1.05 

1.47 

-3.  14 

1.14 

520 

1  0.522 

-0 . 629 

-0.477 

-0 . 343 

2.43 

-1.49 

-3.11 

-0.70? 

529 

1  1.07 

-1.23 

4.29 

-0.429 

1.33 

-1.34 

-1.30 

-1.65 

530 

1  0.472 

-0 . 353 

1.24 

-0.930 

-0. 133 

-0.  196 

-1.92 

0.844 

531 

1  0.541 

-0. 130 

-6.40 

1.39 

-0.993 

1 .27 7E 

-02  0.352 

1.13 

532 

1  -1.05 

0 . 902 

-4.44 

1.05 

-3.01 

2.53 

-0.404 

1.35 

533 

1  -U.637 

-0.330 

2.71 

0.791 

-0.901 

-3. 150E 

-02  -2.35 

2.43 

534 

1  0.246 

7.725E- 

-02 

-3.11 

-0.559 

-3 . 22 

0.210 

-0.236 

3.37 

535 

1  Q . 834 

-0 . 343 

-4.33 

-2.42 

-1.00 

1.56 

2.913E-02 

0.640 

Cic6 

1  2.33 

-1.72 

-5.31 

-1.39 

-2.30 

2.  15 

1.31 

1 .  16 

537 

1  2.34 

-2.01 

-4.23 

-2.44 

2.76 

-4.34 

2.06 

0.96? 

538 

1  3.36 

-3.20 

0.590 

-3.11 

1.71 

-3.41 

0.602 

0.785 

539 

1  3.42 

-3.70 

-2.23 

-1.26 

-0.403 

-0.777 

1.36 

-0.666 

540 

1  -0.395 

-7.063E- 

-02 

2.81 

0.373 

1.45 

-1.45 

-0.933 

-0.551 

541 

1  -0.660 

-0.  166 

2.26 

-0.  !8 1 

3.  10 

-1.87 

-2.02 

-1.15 

542 

1  -5.025c- 

-02 

-0.966 

6 . 67 

-1.03 

1.38 

-0.869 

0.909 

-1.30 

543 

1  -1.92 

1.41 

-4.07 

0.636 

-0.260 

3.938E 

-02  -1.85 

0.689 

544 

1  1.27 

-1.53 

-2.40 

4.496E-02 

1.95 

-3.76 

3.00 

0.630 

545 

1  0 . 765 

-1.53 

-2.82 

0.477 

1.91 

-3.44 

1.03 

0.328 

546 

1  1.12 

-1.52 

1.66 

-1.31 

1.36 

-4.58 

2.53 

0.778 

547 

1  0.753 

-1.34 

1.12 

-0.612 

0.217 

-2.75 

2.73 

1.80 

543 

1  2.07 

-2.  15 

4.53 

-2.  10 

-1.57 

2.602E 

-02  -0.856 

2.08 

549 

1  -0.533 

0.206 

7.52 

-2.46 

-0.505 

-0.382 

-2.23 

2.03 

550 

1  -1.31 

1.63 

1.33 

-1.68 

0.322 

3.682 

-0.875 

-0.405 

551 

1  1.24 

-0.962 

1.43 

-2.87 

1.34 

-1.35 

1.67 

-0.694 

552 

1  0.213 

0.635 

-5.60 

-1.53 

1.34 

-1.11 

1.32 

-1.16 

553 

1  0.996 

-0.625 

-1.76 

-1.56 

0 . 700 

-1.47 

4.30 

-1.01 

554 

1  3.927 

-0.962 

1.33 

-1.21 

0.473 

-2.04 

4.77 

-0.551 

555 

1  2.12 

-2.47 

-1.933E- 

-02 

-0.977 

1.35 

-2.30 

1.38 

0.508 

“ 

1  3.03 

-2.8! 

1.74 

-2 . 39 

1.59 

-1.91 

-1.01 

-3.341 

557 

1  -1.03 

3.336E-03 

7.20 

-1.72 

0.493 

-0.68“ 

0.237 

-0.712 

553 

1  -0.411 

-1.33 

6.59 

0.332 

2.80 

-1.93 

-1.03 

-0.990 

559 

1  3.434 

-1.53 

1.74 

3.472 

1.14 

-0.524 

-1.08 

-4.053E-02 

560 

1  4.075E- 

-03 

-0.493 

-5.340E- 

-02 

0.539 

0.364 

-0 . 673 

-0.370 

0.564 

23 


STANDARD  DEVIATIONS 


,10i  KRLMRN  FILTER  RESULTS  CM  .Cl  II 


TIME  (SECONDS) 

Figure  AT  Plot  of  the  normalized  intensity  estimates  from  the  Kalman 
Filter  for  the  data  of  JO  167,  containing  a  double  peak  due  to 
hOCo.  The  variation  in  the  Background  and  226r3 
intensities  are  likely  the  effect  of  small  corrections  to  the 
model  due  to  differences  between  the  shape  of  the  ^Co 
library  standard  and  the  source  spectrum. 


/Appendix  B:  FORTRAN  Listings,  DEC  RT-11 


1. 

KLPKEP 

2. 

FREEFM 

3. 

DAT  IN 

4. 

OATOUT 

5. 

KFILTR 

0. 

KLIN 

7. 

KINIT 

a. 

LIBIN 

9. 

KSTEP 

10. 

KUUT 

25 
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c 

PROGRAM  KLPREP 

C 

READS  NIAGARA  DATA,  CONDENSES,  AND  WRITES  TO  DATA 

c 

FILE  FOR  USE  BY  KALMAN  FILTER  PROGRAM 

L.-iST  MODIFIED  BY  G .  W.  PH  ILL  IPS,  APRIL  1932 

9001 

INTEGER  DATA  1 192  44 , HEADER (25b)  ,NDRECU6> 

9002 

ECU  I VhL INFS  : DATA , HEADER ) 

0003 

INTEGER  v IS , PERIOD, BLANK 

0G9-1 

EEFL-S  ALPHA, F iLDEr (5) 

0G95 

torv  i '■  -li  .RiH '( -'Dfi  i  ft 

09G6 

cor  HIGH  .  D  A  T A  ?  I D  A  T !  G  0 )  ?F  R  E  E  ?  I N  TE  G ! 16)  ,REALXC  IS) , ALPHA! 16) 

990? 

data  FILDEF?Gh&DEF  12  , 1H  ,1H.,1H  , 1H@/, ABLANK/8H 

0003 

DATA  YES/1HY/, I0UT?5?, IN?5?,LP?S?,NXFEC?-1?,NFILE?12? 

00G9 

DATA  NCH/ 1 6/, INCH? 16?,  i  1S?3?, MF?255?, PER  TOD? 1H . ?, BLANK? 1 H 

0010 

c 

10 

DATA  NDEL?0?,NFSKIP?0?,NRSKIP?0?, IBLK?2H  ? 

0011 

CONTINUE 

0012 

UR  I TEC  I OUT, 20) 

0013 

20 

FORMAT!'  ENTER  *  OF  FILES  TO  SKIP,*  OF  RECORDS  TO  SKIP,' 

1  4X. 'FIRST  RECORD, LAST  RECORD'?) 

0014 

READ ( IN, 39)  [DAT 

0015 

70 

FORMAT (BOA  1 ) 

0016 

N=4 

001? 

M«1 

0313 

MA=  1 

0019 

I  TYPE  =  1 

0629 

CALL  FREEFM ( N , M, NA , I TYPE )  iPARSING  SUBROUTINE 

0021 

IFCN.NE.4)  GOTO  10 

0023 

IFCINTEG(l) .HE. IBLIO  NFSK IP* INTEG! 1) 

0025 

IF! INTEG(2) .HE. IBLK)  NRSK IP= INTEG !2) 

902? 

NREC1=INTEG!3) 

0023 

c 

HF.EC2  =  I NTEG  !  4) 

9929 

NDEL-0 

0030 

WRITE! 1 OUT, 32) 

063 1 

32 

FORMAT ! '  ENTER  UP  TO  16  BAD  RECORDS  TO  DELETE'?) 

0632 

33 

READ ! IN, 34)  L, IDAT 

0033 

34 

FORMAT (Q, 30 A 1 ) 

0034 

IF (L.LE.0)  GOTO  40 

0036 

H= lo-NDEL 

0037 

I F ! N . LE . 0 )  GOTO  40 

0939 

M=  1 

0040 

NA=  1 

0041 

ITYFE-1 

0042 

CALL  FREEFM!N,M,NA, ITYPE) 

0943 

IF(N.LE.O)  GOTO  40 

0045 

DO  35  I = 1 , N 

06  46 

35 

NDRECINDEL+I)  -  INTEG!  I) 

0047 

NDEL-NDEL+N 

0G43 

GOTO  33 

MIDAS  -OP i FAN  IV 
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0043 

c 

.'.0 

UR! TEE  I0UT.41) 

3:50 

i 

F JPMAT ( ’  IN 7ER  STARRING,  FINAL  DATA  CHANNELS’ 

1  ’  C,*  OF  OUTPUT  CHANNELS  FOR  FILTER)’/) 

035 : 

PEAT-:  IN,-, 2)  I  DAT 

rr  n 

42 

FOP’  'AT i,30f':  1  '• 

7  '  j  5  3 

N=I 

C  j54 

r  =  ! 

0035 

HA  =  i 

0055 

IT."  I*  1 

0057 

CALL  FREEFMCN,M,NA, I TYPE) 

3353 

IFEN.LT.2)  GOTO  35 

0030 

NS“ IHTEGi l ) 

0&b ! 

NF*INTEGC2) 

PC  4  2 

•F  f N.EQ.3)  MCH= INTEG < 3) 

0064 

r 

IFENCH.GT. INCH)  NCH=IHCH 

L 

C 

c 

50 

INITILIZE  OUTPUT  FILE 

0956 

IT  I TE I OUT, 5! ) 

0967 

51 

FORMATE'  FILENAME  FOR  DATA  OUTPUT’/) 

0063 

READ (IN, 52)  LEH, I DAT 

0869 

52 

FORMAT (Q.S0AI) 

307O 

DO  54  1  =  1,  LEN 

0871 

54 

IFEIDATEI)  .EQ.  PERIOD)  I  DAT  (I)  “BLANK 

0873 

N  =2 

8074 

HA* ! 

0075 

!'1=  1 

0076 

I  TYPE =3 

8377 

CALL  FREEFM(N, M, NA .  I TYPE) 

8079 

F ILDEF(2) =ALPHA ( 1) 

0979 

FIL9EFE4) “ALPHA (2) 

0390 

IFENX.LT. 2)  FILDEFE 4)  “BLANK- 

0302 

CALL  MCLI(FILDEF) 

0033 

NMFL  =0 

0Q34 

CALL  GANDC ( NF I LE , NEPR , NDEV.NA23. NVLS . HDTV, NRCZ , NBYL.NMFL ) 

0035 

r 

DEFINE  FILE  HF ILE E 4096, 2, U, IV) 

0036 

L 

UR  I TEE I0UT.56) 

0887 

56 

FORMAT (’  PRINT  OUT  CONDENSED  SPECTRA,  YES  OR  NQ?’,$) 

0393 

READ ( IN, 58)  IANS 

0089 

53 

FORMAT (A  1 ) 

0090 

NPRT =0 

0091 

r 

IF ( IANS . EQ . YES)  NPRT=1 

L 

c 

INITIALIZE  MAGTAPE 

c 

3039 

0334 


MODE ■ 2 

CALL  DAT IN (MODE, MR) 
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r 

C  I  "  IP  FILES  ON  TAPE 

C 

9095  £3  IFttiXREC.LT.Q)  GOTO  52 

9097  IF '^FFKIP.EQ .□>  GOTO  64 

3039  52  LODE  =5 

3100  IR-LFSMIP 

3191  CALL  DATHUilODE, NR) 

-3132  . .REC=0 

C 

C  READ  HEADER  RECORD 

C 

3103  64  IFCNXREC.GT.3)  GOTO  65 

0105  NODE =4 

3106  NP=NXREC 

6107  CALl.  DAT  IN  (MODE,  NR) 

0193  65  NTIME=10*CNREC2-NREC1+1) 

-3199  UR  I TE  C  LP . 66 ) C  HEADER  C I ) , I  =  1 , 10 ) , NREC 1 .  NREC2 ,  NT  I  ME 

3110  66  FORMA  T( 1H1.2X, 7A2.3I6/'  RECORDS' , 15. *  TO', 15. 

1  p  p  15  p  SETOHDS' /) 

3111  IJR I  TEC I OUT i 67) ( HEADER ( 1) , 1=1, 10) ,NREC1,NREC2,NT1ME 

0112  67  FORMAT ( IH  . 2X, 7A2, /3 16/'  RECORDS' ,  15. '  TO', 15, 

1  ',',15,'  SECONDS’/) 

0113  NXREC- 1 

0114  IV- 1 

0115  DO  68  1=1,10,2 

0116  63  IJR1TECNFILE' IV)  HEADERC I) .HEADER ' 1+1) 

0117  URITECNFILE’ IV)  NREC1.NREC2 

0113  URITECNFILE' IV)  NTIME.NCH 

0119  URITECNFILE’ IV)  MS.MF 

C 

C  SKIP  RECORDS 

C 

0123  63  IF  CNRSK IP  . EQ  .O’1  GOTO  70 

0i  22  MODE =6 

0123  NR=MRSK IP 

3124  CALL  DATINCMODE.NR) 

0125  NXREC =NXREC+NRSK I P 
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CC 


c 


1  ’  26 

70 

3127 

■  t  ■-■ri 

3133 

3131 

3122 

3133 

3135 

0137 

3  1 38 

74 

0123 

73 

0142 

30 

3 1 43 

0144 

3 1 

0  1 45 

014b 

96 

0:49 

0153 

0151 

3152 

0153 

92 

0154 

0156 

0153 

0159 

3  260 

95 

3161 

9S 

0  2  63 

0164 

0165 

97 

0166 

100 

MAIM  LOOP 

NRSTO? -399? 

KFPT-Q 

JO  1  ~'0  1  =  .  3T0R 

:  'OEE-r 
mr=h:  :?uc 

CALL  DA  TIN  :',OJE,MR' 

m:-pec=;ir+i 

IFCNR.'.T.NPECl)  GOTO  133 
IF  uIDEL.LT.  p  GOTO  73 
DO  74  J  *  1 ,  NDEL 

I F (NR . EQ .  HDREC  ( J)  )  DATA  <  15)  =-999 

IF (KPPT.NE.9)  GOTO  93 

CALL  BTIMEC  I  DAY,  IYR,  I  HR,  IMIN,  ISEC) 

WRITE C I OUT, 3 1 )  HR, I HR, IMIN, ISEC 
FORMAT ( '  BEGINNING  AT  RECORD', 14, 

*  '.AT  ',12.': ',12,': '.12/) 

KPRT= 1 

IF  CNR.GE.NREC2)  I=i!RSTOP 
IFCNR . LT. 3993)  GOTO  92 
I =NRSTOP 
NR-NXREC- 1 
GOTO  96 

CALL  DATOUT (MS,MF,NCH,NF ILE.NRRT, IV) 

I F ( MOD ( NR , 1 00) . ME . 0 )  GOTO  95 

IF (MR . GE . 9999)  NR-NXREC-1 

CALL  BT I ME (I DAY, IYR. I HR, IMIN, ISEC) 

UR  I TE ( ! OUT, 95)  NR , I HR , I MI N , I SEC 

FORMAT ( '  PROCESSING  COMPLETED  THROUGH  RECORD 

*  ',  AT  ',12,':', 12.':', 12/) 

I F  C I . LT.NRSTOP)  GOTO  100 

CALL  BTIME ( I DAY, IYR, I HR . IMIN, ISEC) 

UR  I TE ( I OUT, 97 )  HR, IHP, IMIN, ISEC 
FORMAT ( '  THE  END  RECORD  IS'.  15, 

*  AT  ',12,' : 12.’ :', 12/) 
CONTINUE 


'.154, 
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C 

C  END  G~  'IAIN  LOOP 
C 


GLOBE  OUTPUT  FILE 


u !  sr 

ENDF -Lt  i IF  I LE 

3163 

r* 

CAu-  CLCSEUC-ir  TLE) 

9163 

IF 1  ,::;7'T.2Q.  1)  UP  ITE(L?,  129) 

9 !  7  l 
0172 

120 

FLs'UhF'  1-1' 

UR T TE < I OUT j.  150) 

9173 

3174 

150 

FORMA T ( ’  DO  YOU  UISH  TO  CONTINUE?',/) 
READ (IN, 200)  NEUGP 

0175 

0176 

200 

C 

C 

r 

FORMAT (A  1 ) 

IF (NEUOP.EQ.YES)  GO  TO  10 

CLOSE  MAGTAPE 

3178 

0173 

3189 

L 

1000 

MODE =10 

CALL  DAT IN (MODE, HR) 

URITEClP, 1010) 

0181 

0182 

1010 

FORMAT',  lhl) 

END 

30 


-•i-Ac  zre-'-Vl  IV  STORAGE  MAP  MOD  000360  INTEGER *2  PROCEDURE 

"  '  '  CLOSEU  000060  .TEA  L*4  PROCEDURE 

NEL:OP  001366  INTEGERS  VARIABLE 


HATE 

■JFFSE1 

ATTRIBUTES 

» 

COMMON 

bloc:-:  /or 

RAY/  LENGTH  004000 

m:-rec 

00 SOYS 

INTEGER  VI 

ARRAY  (IS) 

F  I_Dt;P 

r  c  j  }»:s5 

"  SAL  '-0 

ARRAY  5) 

DATA 

f!0n^r(  rj 

INTEGER*?  ARRAY  (1.024 

v  E  i 

.  C  O  ••  *.2 

IN i EhER  V. 

VAR  I  ABLE 

•-.'SADIS* 

000  0  :'U 

INTEGER/?  ARRAY  (256) 

^E? I OD 

■  r  -'i  •  ■ 

INTEGER  V; 

VARIABLE 

3w  All' 

'  . '-'.j 

1  ;  | -  :■ 

VAR  I  GELS 

ccririON 

block  /da 

TA/  LENGTH  000240 

•-.2_A:-:: 

6 •.  . 

nsh.l  m 

'-•.-V  {ASLi 

: j  r 

OOOIZ- 

INTEGER*? 

VAR IA3LS 

I  DAT 

000000 

INTEGER*?  ARRAY  (80) 

IN 

000126 

INTEGER*,5. 

VARIABLE 

LP 

066 1 30 

INTEGER*:.5 

VAR  I  ABLE 

COMMON 

BLOCK  /PR 

EE/  LENGTH  000340 

NXREC 

060 1 32 

INTEGER*,5 

VARIABLE 

NFILE 

660 134 

INTEGER*,? 

VAR  I  ABLE 

I  NT  EG 

00Q0C0 

INTEGER*?  ARRAY  (16) 

NCH 

660136 

IMTEGER*2 

VARIABLE 

REALX 

60O040 

REAL *4  ARRAY  (16) 

INCH 

600140 

INTEGER *2 

VARIABLE 

ALPHA 

060140 

PEAL *3  ARRAY  (16) 

ns 

000142 

INTEGER*? 

VARIABLE 

i  IF 

060144 

INTEGER*:. 

VARIABLE 

NDEL 

000152 

INTEGER  *2 

VARIABLE 

NFS!''  IP 

600 15-t 

INTEGER*?. 

VARIABLE 

NE3K  [P 

060156 

INTEGER  "C? 

VARIABLE 

IBLK 

080 166 

INTEGER *2 

VARIABLE 

N 

00 1 260 

INTEGER *2 

VARIABLE 

M 

001262 

INTEGER*.? 

VARIABLE 

NA 

001264 

INTEGER*:5 

VARIABLE 

ITvPE 

CO  1266 

INTEGER*:5 

VARIABLE 

FPEEf-'M 

000060 

REAL*4 

PROCEDURE 

NREC  l 

001270 

IMTEGER*2 

VARIABLE 

NREC? 

C61272 

INTEGER*;? 

VARIABLE 

L 

601274 

INTEGER*,? 

VARIABLE 

I 

001276 

INTEGER*? 

VARIABLE 

LEN 

001300 

INTEGER*? 

VAR  I ABLE 

NX 

GO 1302 

INTEGER*? 

VARIABLE 

i'ICL  I 

000900 

INTEGER*? 

PROCEDURE 

Mi  1FL 

061304 

INTEGER*? 

VARIABLE 

OANDC 

-OOO000 

REAL*4 

PROCEDURE 

KERR 

001366 

INTEGER*? 

VARIABLE 

NDEV 

001310 

INTEGER*? 

VARIABLE 

NABS 

001312 

INTEGER*,? 

VARIABLE 

NVLS 

001314 

INTEGER*? 

VARIABLE 

NDTY 

00 13 16 

INTEGER*? 

VARIABLE 

NRCZ 

00 1 320 

INTEGER*? 

VARIABLE 

NBYL 

001322 

INTEGER*? 

VARIABLE 

IV 

001324 

INTEGER*? 

VARIABLE 

IANS 

001326 

INTEGER*? 

VARIABLE 

MART 

O01330 

INTEGER*? 

VARIABLE 

MODE 

301332 

INTEGER*? 

VARIABLE 

CATIN 

000000 

REAL *4 

PROCEDURE 

HP 

0O133-1 

INTEGER*? 

VARIABLE 

NT!  ME 

001336 

INTEGER*? 

VARIABLE 

NRSTOP 

001349 

INTEGER*? 

VARIABLE 

KEPT 

201342 

INTEGER*? 

VAR  I ABLE 

T 

J 

001344 

INTEGER*? 

VARIABLE 

BTIi’iS 

600000 

REAL*4 

PROCEDURE 

IDAY 

601346 

INTEGER*? 

VARIABLE 

IVR 

001350 

INTEGER*? 

VAR  I  ABLE 

IHR 

001352 

INTEGER*? 

VARIABLE 

1MIN 

GO  1 354 

INTEGER*? 

VAk I HOLE 

I  SEC 

601356 

INTEGER;:? 

VARIABLE 

DATC1JT 

3O0GOO 

REAL*4 

PROCEDURE 

31 


L  INKER 


'/02-fl-  l 


LOAD  TOP 
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ij 

SIZE 

ENTRY 

iv'DR 

ENTRY 

AD  DR 

ENTRY 

APDR 

■*»«'* 

003000 

•z\_ 

0032 1 0 

SHlCHN 

000006 

SIJSFSU 

0SO209 

i'f"  ■»" 

: ooooo 

i  1  + 

004737 

■J  .  J 

JO-? 

■.0-20  i 

~  "  ‘  .  ■" 

'I;  125-1 

r  ty. :  r 

0  2C  2  23 

:  - 

+  • 

-  -  -  - 

:  nvjjO 

+  i _ 1 4 

5-i 

204240 

DATA 

G25254 

025254 

2 002  40 

0255 14 

000340 

FREE 

825514 

8253 »4 

20834O 

r  ■“  i-  n  ^ 

005302 

P 

001310 

DATOIJT 

0 O  3i5b 

« -4Soo 

002572 

DAT  IN 

334656 

037560 

088554 

I  BCD 

037550 

040134 

03O210 

ILSHFT 

040134 

040344 

033106 

FREEFM 

040344 

042452 

000260 

HM ! S I I 

042452 

NMISMI 

0425OO 

NMIfPI 

342506 

HP  1 5 i I 

042516 

NPISMI 

042522 

HP  IS? I 

042526 

04,532 

012Q064 

NMI3IP 

042532 

NMISMP 

042564 

NMISPP 

042572 

NPISIP 

042602 

NPISMP 

042606 

NPTSPP 

942612 

6426  It* 

000044 

NMIS1P 

042616 

NPIS1 1 

042636 

NPIS1M 

042550 

NPIS1P 

042632 

042262 

300040 

MOD 

0-12652 

242722 

0:00110 

TADS 

042752 

TAPS 

042760 

TA  IS 

842722 

TALS 

042733 

TAPS 

042744 

i  hGS 

342736 

043032 

000056 

SOT  1 3 

043032 

043110 

000210 

ISHS 

243110 

LSN3 

043130 

3 1  SNTP 

343114 

SLSNTR 

043 i *4 

0-3320 

f  nr  n  -i.j 

7.01.3 

043320 

P  •  ’  *  ”  i  - 

bL'QObo 

DECS 

p  ..!33c.;5 

2,2  +5-1 

■100044 

PETS 

0-13470 

RSTSF 

043460 

RETSI 

043465 

RETSL 

043434 

043520 

081 106 

I  BPS 

0435.26 

I  BUS 

043520 

SIBU 

043532 

044626 

260072 

ENCS 

044625 

044720 

000020 

IFRS 

944720 

IF  US 

044732 

044740 

921562 

SF IO 

O  ;‘5426 

046522 

Q02344 

DCOS 

050 1 46 

ECOS 

05G140 

FCOS 

053134 

GCOS 

050125 

IC  IS 

046530 

icos 

347732 

OCIS 

046522 

ocos 

047674 

RC  IS 

346724 

SGF.T 

046710 

051066 

000110 

SDUMPL 

051G66 

02  1 176 

000036 

JGETF I 

051176 

051234 

200042 

D I  ISIS 

051246 

D  1 1  SMS 

05I242 

D I  I  SPS 

051234 

D! ISSS 

05 1 250 

SDV I 

051250 

0512*6 

200040 

MU  ISIS 

2513I0 

MU  I  SMS 

05 1334 

MU  ISPS 

*51275 

'  ;U  1 35  5 

05 1312 

SUL  I 

051312 

<■'51335 

:  23  120 

3FCHNL 

051:36 

f  rr  '  cr 

'4  „  .  r  J  .« 

22104-1 

3  c -.3 

051475 

Lli  *  j  21  -7 

05 ! 506 

3  GTS 

951504 

B! _ :  '3 

83 1  -174 

BP*  i? 

05  15  10 

l  rn  c;  ■  ~  “■  -> 

000032 

Hn'jTS 

:~1  4.;  ]  C  ">  -~j 

^  ~  " 

>J  lL:'] 

U_  i  '.3 

T 

■J  51534 
0:1724 

'•.i 

. :  :  I 

j;  ;r:r 

1  . !  -  J ' 

.  -■  O 

...  ..... 

- 

jtttti 

I  r  "  J  -  - 

:  ;o  •  - 

52’jJ2 

i  j  . 

!j-J  17"  J 

I  r,:j  iQ2 

i  x<  i  3  1 A 

’?  32031 

ro r  sma 

0520.45 

i  :c  i  ssa 

{_'  :!J  1  o 

11C  i  .784 

952862 

MO  1 -5 1 H 

032102 

1101.3 1  £ 

052022 

0521 10 

CCC04S 

orusip 

052  1 18 

CM  1 3PM 

952130 

cmissp 

6:2112 

,ic-  *  i  crc 

000044 

CM  131 1 

952176 

ciiism  i 

1  ~J 

CM  133 I 

952162 

-52222 

2C03 34 

DC  ISA 

852252 

DC  I  S3 

352240 

ICISP 

952232 

052252 

000345 

su [sip 

852256 

SU (5PM 

932310 

SOI S3? 

052260 

G52324 

300844 

S'JISIA 

952344 

S'JISMA 

932360 

SUISSh 

952339 

052370 

800047 

AD [SIP 

052370 

AD  1 5PM 

052422 

AD  I  S3? 

952372 

.  j  -  1^7 

3 G 0044 

AD (31 A 

932436 

AD  ISM A 

032472 

AD  153 A 

052442 

052502 

000064 

M0I3IP 

952592 

MOISPM 

052534 

M0 I S3 P 

052594 

052566 

080942 

MOrSMA 

052609 

MQFSPA 

052620 

052630 

0QO032 

3 A  I SIM 

0^2630 

3VI5IM 

052643 

052S62 

O00032 

T3DSI 

052702 

TSDSS 

052666 

T3FSP 

032796 

T3ISM 

952676 

052714 

000O34 

CPPS3M 

052735 

CPL3311 

052714 

'■|7"i"7  r 

300030 

LPns 

”,  “  ”  “j 

LLIIS 

032730 

3CTS 

951516 

ENE3 

351514 

NM 131 I 

051465 

MM I  SIM 

85  1 456 

CD  IS 

051324 

CF  1 3 

I1 5 '340 

3 1 D 

051524 

SIP 

35 1 3  48 

•  ISM 

85.3  J 

;;  if  jp 

>:  ;  £T:; 

22’ '3 

1 l: !  ^  ‘ 

*  r  t 

.■5:782 

;.  L3 

1 .5 1 7  •;  j 

i  :9 ;  spm 

iy-j  i  i? 

M2  1 37? 

j;  22  93 

molsps 

051779 

i‘  10  13 1 M 

032 U 2  - 

.  ’.J  ISIS 

1*52  j  22 

M0ISMM 

052042 

Ml :  l‘i  "3 

332336 

MJIS3M 

0520.2 

Mu ICSS 

052G96 

M0 I COM 

'J  ::2G5o 

MO  1 393 

352052 

mo i s i r 1 

85237  4 

MO  ISIS 

7152066 

MDLSSS 

0529S6 

RED  3 

352322 

CM I CMP 

052129 

CM  ISP  I 

352 1 42 

CMISPP 

052139 

CM ISPS 

052134 

CMISIM 

952202 

CM I  SIS 

852172 

GMiSMM 

052216 

CM I  SMS 

052206 

CMIS3M 

052  1  bo 

CM ISSS 

352156 

DC  ISM 

052244 

DC  ISP 

952250 

ICISA 

052234 

ICISM 

852226 

ICISS 

052222 

3UISMP 

052272 

SUI3PA 

052316 

SUI3PP 

052266 

3UISP3 

352302 

SU I $1 M 

852353 

SU ISIS 

052340 

SU ! 3MM 

052364 

SU I CMS 

052354 

SUI3SM 

052334 

SUISSS 

052324 

hDISMP 

0524Q4 

ADZ. SPA 

Q52430 

ADISPP 

052400 

AD  I  SPS 

952414 

AD  I SIM 

852462 

AD  ISIS 

3  *j  24  d  2 

ADISMM 

352476 

AD  I  SMS 

052466 

ADISSM 

0  2  44b 

ADI  -ubh 

052436 

M0ISMP 

052516 

MOISPA 

952542 

M0 ISP P 

0525  2,2 

MO  ISPS 

052526 

MO  I SOP 

052558 

M0IS1P 

052556 

MO  F  Si  in 

052566 

M8FSMP 

352606 

MOFSPM 

05261.4 

MQFSPP 

052624 

SAISMM 

052652 

SAISSM 

G526S2 

SVISMM 

052656 

SVISSM 

852642 

TSBSM 

052676 

TSDSP 

932706 

IS"  SI 

052702 

TS’-SM 

952676 

T  jF  S3 

052672 

T'S  1 3 1 

952702 

T3  IS? 

032706 

T51SS 

1 52 £62 

CPFSSM 

052724 

CPICSM 

852720 

CGES 

952762 

LGT3 

852763 

LLT3 

052774 

LMi; 

852772 

33 
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00!  SUBROUTINE  FREEFM(M,M,NA, I TYPE) 

C  LAST  REVISED  AUGUST  1981  BY  G.W.P. 

C 

C  GENERAL  SUBROUTINE  TO  DECODE  DATA  READ  IN  FREE  FIELD  FORMAT 
DELIMITERS  ARE  EITHER  A  SLANT  OR  A  COMMA 
C  THE  ROUTINE  ASSUMES  THE  DATA  HAS  SEEN  READ  INTO  ARRAY  IDATA  WITH 
C  THE  FORMAT  (30 AD 

C  N  IS  THE  NUMBER  OF  DATA  ELEMENTS,  MAXIMUM- 16 

C  N  IS  RETURNED  AS  THE  NUMBER  OF  DATA  ELEMENTS  FOUND 

C  M  IS  THE  LOCATION  III  THE  ARRAY  FOR  STORING  THE  FIRST  DATA  ELEMENT 

C  M  IS  RETURNED  AS  THE  LOCATION  FOLLOWING  THE  NTH  DATA  ELEMENT 

C  NA  IS  THE  BEGINNING  COLUMN  OF  THE  DATA 

C  NA  IS  RETURNED  AS  THE  COLUMN  FOLLOWING  THE  NTH  DATA  ELEMENT 

C  I TYPE  IS  THE  TYPE  OF  DATA, 

C  1= INTEGER 

0  2=PEAL 

0  3 -ALPHANUMERIC 

C 

3002  COMMON/DATA/ I DATA ( 80 ) 

0003  C0MM0N/FREENINTEG(16),REALX( 1S),ALPHA(16) 

8004  INTEGER  SEMI, E, COMMA 

0005  REAL*3  ALPHA, BLANK 

0006  DIMENSION  I TEMP (20) ,AFGRM(2) 

9007  DATA  SEMI ,E, IBLK1 .COMMA, IBLK2, BLNK4, BLANK 

*  E V,  V  V  V  V 

C 

0008  L-M 

9009  M=M+N- 1 

8010  DO  300  I =L, M 

8011  IF (NA . GT. 80)  GO  TO  400 
0 

C  LOOK  FOR  START  OF  CURRENT  FIELD 

r 

0013  DO  210  J  =HA, 80 

3014  JQQ=J 

0015  IF ( IDATA (J) ,NE. I3LK 1 )  GO  TO  215 

0017  210  CONTINUE 

0013  NA=8 1 

0019  GO  TO  400 

0020  215  IF ( 1DATACJ00) ,NE. COMMA)  GO  TO  220 

8022  NA-JQQ+1 

0023  GO  TO  290 


:as 

FORTRAN  IV  21  DEC  1934  10;. 

r 

c 

log:-:  for  end  of  current  field 

c 

i2~ 

220 

il=jqq 

125 

ILC.  =  !L 

!2b 

■  -  i 

DO  230  J= iLQ,30 

)2_ 

:■ = j 

J  _'C; 

IF*.  I  DATA  ( J  '  .  2Q .  I  ELK  1 )  GO  TO 

)39 

IF C I DATA < J) . HE . COMMA 3  GO  TO 

332 

I R  =  J  —  1 

333 

NfW+1 

334 

GO  TO  250 

335 

233 

CONTINUE 

33b 

I R  =80 

337 

NA=8 1 

333 

C 

GO  TO  250 

c 

CHECK  FOR  EXPONENT 

C 

339 

235 

IF( ( ITYPE.NE.2) .OR. C IDATA  CJQQ- 

041 

ILQ  =  JQQ  +  1 

042 

GO  TO  221 

043 

236 

IR= JQQ  -  1 

044 

c 

I J=JQQ+1 

c 

SET  NA  TO  START  OF  NEXT  FIELD 

C 

045 

DO  240  J=IJ,30 

946 

IF ( IDATA (J) .EQ. IBLK1)  GO  TO 

C43 

NA=J 

949 

IF f IDATA (J) . EQ . COMMA )  NA 

951 

GO  TO  250 

|052 

240 

CONTINUE 

'053 

c 

NA=8  1 

C 

ENCODE  DATA  IN  CURRENT  FIELD 

C 

1054 

250 

NI-IR-IL+1 

1055 

IFCNI.LT. I)  GO  TO  290 

105? 

ENCODE CNI .255, I TEMP )  C IDATA (J) 

1053 

255 

FORMAT C33A1) 

PAGE  002 


»  1 


36 


IPS  FORTRAN  IV 


11  JAN  1935  2:49:43  PM 


PAGE  002 


37 

:  os 

10 
t  ~ 

14 

15 

101 

16 

1 7 

102 

1? 

2 1 

22 

184 

O  T 

j 

c 

24 

105 

D 

D  1 10 

Tier 

D 

D  120 

(26 

127 

123 

200 

,29 

130 

218 

131 

D 

D212 

132 

D 

D214 

133 

134 

335 

220 

136 

137 

230 

333 

D 

D240 

339 

348 

342 

343 

344 

250 

34^ 

2 ,7  jj 

CALL  KL I N  ( K ,  Y ! ,  Y2 ,  NR .  N 1 P .  M .  MS .  MF ) 

IFCNR.LT. (3)  GOTO  300 
IF ( IMIT.ME.0)  GOTO  102 

CALL  K IMiTC X l , X2 , Y 1 » Y2 , H , V 1 , V2 ,P1,P2.Q1.Q2. 

S 1 . 32 . N 1 . H2 . M, MS . MF ) 

CALL  31 ™3 C I PAY, IYR, I HR, !MIN, !SEC) 
up  ;te(  iCPT,  i  r,  i )  hr  ,  i  -ip .  in  in,  isec 
FORMAT  ( ’  ’“'BEG  INNING  AT  RECORD  ',14, 

!  ’  »  AT  ’ .  12,  .  12,  •  :  •  .  12-0 

I H I T  =  1 

IFCNID.EQ. 1 .0R.N1D.EQ.2.0P.H1D.EQ.3)  GOTO  105 
I F  C N I P . GT . 10.AND.NIP.LT. ISO)  GOTO  105 
WRITE  CLP. 104i NR, HID 
FORMAT (15. 13) 

GOTO  100 


L  =N  1 

UP ITE ( ICPT, 1 10) K, NR 

FORMAT C ’  ROD  1,  CALLING  KSTEP.  STEP’, 14.',  RECORD’ 
CALL  KSTEP  CK . XI , Y1 . S 1 .0,01 . R 1 . N 1 . M. NR ) 

WRITE'.  ICRT,  123) 

FORMAT C ’  CALLING  DDKALM’ /) 

CALL  DDKALM ( K . X 1 . H ,  Y 1 . S 1 . Q . R 1 , V 1 , 

1  IN.  IS,  I L , N 1 , M , L . T 1 , T2 , IT.T3. IER) 

DO  2E3  J  =  1 , M 
Rl(Jj =T3( J) 

DC  210  1=1, Ml 
P  1 C I )  =V 1 C I ,  I) 

L=H2 

UR ITE  C ICRT, 2 12) K, NR 

FORMAT C ’  POD  2,  CALLING  KSTEP.  STEP’. 14. RECORD’ 
CALL  KSTEP C K , X2 ,  Y2 . S2, Q, 02, R2 , N2 . M, MR) 

WRITE (ICRT, 2 i4) 

FORMAT C '  CALLING  DDKALM’ -O 
CALL  DDKALM CK,X2,H, Y2.S2.Q.R2. V2 . 

I  IN, IS, IL,N2,M, L.T1.T2. IT.T3, IER) 

DO  220  J  = 1 , M 
R2( J) -T3CJ) 

DO  238  1=1, N2 
P 2(1) =V2 (1,1) 

K=K+1 

UR ITE (I CRT, 240) 

FORMAT ( ’  CALLING  KOUT’ ) 

CALL  KOUT ( K,NR,NID,X1,X2,P1,P2, Yl, Y2.S1.S2, 

1  Q1.Q2,P1 .R2.N1 .N2.M.MS.MF) 

I F ( MOD ( NR . 50 ) . HE . 0 )  GOTO  2S0 
CALL  BTIME ( I DAY, IYR, IHR, IMIN, iSEC) 

UP ITE ' ICPT. 250)  HR . I HR , IMI N , I SEC 

FORMAT <’  PROCESSING  COMPLETED  THROUGH  RECORD’, 14, 

/  ’  .  AT  -  .  12  .  ‘  :  1  .  12,’  :  ’ ,  12,/) 

I F  ( NP  .  GE  .  0 ''  GOTO  100 


,  14/) 


,  14/) 
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PROGRAM  MFILTR 

R'JNS  KALMAN  i:ILT5P  FOR  NIAGARA  DATA 

LAST  MODIFIED  3Y  G .  U .  PH  ILL  IP'S,  JANUARY  1935 

1 : ;  ( g )  , ;<2 '.S'  .  H ( Q ) , n ( 3 )  .  i  r. g . g ) ,  V2 1 3 , 3 ) 

4  Y  \  ( 1 S  1  .  T  2  1  1  S  J  .21  L  lb)  ,22  1  :  h  J 
1  '*> .  1  ’r '}  T2  •  i  o ,  1  o ) ,  F  j  v  lb1 
-4  5U  NS  .3;  .  92 (.  16.31'  ,Q  1  ;.3)  »Q2<3)  ,Pl  ,P2f.3) 
n  o-  ,  NNS-N  IL  3-N  13/16/, iT/l6/,NR/0/, i CRT/5/, LP/6/ 
IN  IT  0- 


:  i  i  -i 

YATA 


midas  fortran  iv 


STORAGE  MAP 


NAME 

OFFSET 

ATTRIBUTES 

8000 1  :■ 

REAL  .4 

PARAMETER  ARRAY  (1 

v  _ 

CO  00.10 

PEA'. 

Parameter  array  t  i 

:  ■' 

ococs-a 

I  NT ELcP  42 

ARP  AY  i.  16) 

I  ,-i  TE 

00  DOT  4 

INTIEERoL 

TREAT'  12) 

'  I  "  E  0 

000104 

INTEGER  2 

ARRAY  (  16) 

r  lu.’EF 

000 164 

real  ■■ 

ARRAY  i.5‘.' 

i' 

0000  14 

INTEGERS 

PARAMETER  VARIABLE 

NR 

090302 

INTEGER::;;? 

PARAMETER  VARIABLE 

N  I D 

03O024 

INTEGER *2 

PARAMETER  VARIABLE 

NCM 

00002S 

INTEGERS 

PARAMETER  VARIABLE 

ns 

000030 

INTEGER *2 

PARAMETER  VARIABLE 

nF 

00O032 

INTEGERS 

PARAMETER  VARIABLE 

per  I  HD 

000240 

INTEGER *2 

VARIABLE 

BLANK 

000242 

INTEGERS 

VARIABLE 

17 

000234 

INTEGERS 

VARIABLE 

LP 

000236 

INTEGER *2 

VARIABLE 

IN 

00824^ 

INTEGERS 

VARIABLE 

IQiJT 

600246 

INTEGERS 

VARIABLE 

NFILE 

000253 

INTEGERS 

VARIABLE 

IBLK 

000252 

INTEGERS 

VARIABLE 

IN  IT 

000254 

INTEGER *2 

VARIABLE 

LREC1 

000256 

INTEGERS 

VARIABLE 

LREC2 

08926O 

INTEGERS 

VARIABLE 

NDEL 

000262 

INTEGER  k2 

VARIABLE 

LEN 

001174 

INTEGERS 

VARIABLE 

! 

001  176 

INTEGERS 

VARIABLE 

N 

001203 

INTEGER *2 

VARIABLE 

NA 

0012C2 

INTEGERS 

VARIABLE 

n 

0O12G4 

INTEGER.^ 

VAR  I  ABLE 

IT'.- PE 

30 1 206 

INTEGERS 

VARIABLE 

FPEEFM 

003000 

REAL  m 

PROCEDURE 

nCLI 

00001 0 

INTEGERS 

PROCEDURE 

MPEC  1 

001210 

INTEGER  *2 

VAR  I  ABLE 

NPEC2 

C0121? 

INTEGERS 

VARIABLE 

NT  I  ME 

G01214 

INTEGER *2 

VARIABLE 

MAYO 

0O0003 

INTEGERS 

PROCEDURE 

riiN0 

000000 

INTEGERS 

PROCEDURE 

ATiriE 

000900 

REAL  M 

PROCEDURE 

LR 

0O1216 

INTEGER *2 

VARIABLE 

COMMON 

BLOCK  /DATA-'  LENGTH  000240 

IDATA 

009000 

INTEGERS 

ARRAY  (80) 

COMMON 

BLOCK  /FREE/  LENGTH  800348 

IN  TEG 

003000 

INTEGER  ';2 

ARRAY  (16) 

F’EALX 

000340 

REAL  t:4 

ARRAY  (16) 

ALPHA 

000140 

REAL  t 3 

ARRAY  (16) 

COMMON 

BLOCK  /HDR/  LENGTH  900024 

HEADER 

009000 

INTEGER +2 

ARRAY  (10) 

wOMMON 

BLOCK  / 

IQ/  LE 

1NGTH  030004 

IQ  1 

000000 

INTEGERS 

VARIABLE 

IQ2 

0O9002 

INTEGERS 

VARIABLE 

48 
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c 

c 

READ  OBSERVED  SPECTRA  FOR  PODS  1  AND  2 

0034 

200 

iri.LR.LT.  f  1 F E C 2  >  GOTO  210 

DOSS 

NR— NR 

0C3? 

RETURN 

0Q3  0 

3  19 

READ  ■:  i  !F  ! LE '  I V .  21  !D  =  390 >  NR  .MID 

■3039 

IF  '.HR  .ME.  LR+1 )  NID-0 

0&91 

IF'INR.GT.D)  GOTO  229 

0033 

NR=0 

3094 

c 

220 

IF (NID.GT.0)  NID=-NID 

0996 

LR-NR 

0G9? 

DO  230  1=1, NCH, 2 

0093 

230 

READ(MFILE' IV, END =330)  IY( I) , IY( 1+1) 

0099 

DO  240  1=1, NCH 

0100 

240 

VI C I) = I YC I) 

0101 

DO  260  1=1, NCH, 2 

0102 

260 

READ  CNF  ILE  ‘  IV,  END-300)  IYU),  IYU+1) 

0103 

DO  270  1=1, NCH 

0104 

270 

Y2  ( I )  =  I Y  ( I ) 

0105 

IF (NR.LT.NREC1)  GOTO  210 

010? 

IF (NDEL.LE.0)  GOTO  230 

0109 

DO  274  1=1, NDEL 

0110 

274 

r 

IF  (NR .  EQ.NDREC  ( I) )  N  ID— 399 

0112 

L 

280 

CONTINUE 

D 

URITECLP»232)NR,NID,  CY1CI),  1  =  1, NCH) 

D232 

FORMAT C1H0, 'OBSERVED  VECTORS.  RECORD*, 14 

D 

1  IX. 'POD  1' ,8G 13.3/ (7X.3G 13.3) ) 

D 

UR  I TE CLP, 284) ( Y2 ( I ) , I = 1 ,NCH) 

D284 

FORMAT ( IX, ' POD  2' , QG 13 . 3/(?X. 8G 13 . 3) ) 

0113 

P 

RETURN 

01  14 

300 

WRITE ( I0UT.3 10)  NR 

0115 

310 

FORMAT ( '  PREMATURE  END  OF  DATA  AT  RECORD 

0116 

NR— NR 

0117 

RETURN 

0113 

END 

MODEM  4/ 


14/) 


"  • 
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0043 

C 

NDEL=0 

0044 

URITEUO'JT,  132) 

0045 

132 

FORMAT':'  ENTER  UP  TO  IS  BAD  RECORDS  TO  DELETE*/) 

004b 

1  bb 

READ c IN, 134)  LEM, IDATA 

0047 

134 

FORMAT' O.30A1) 

0043 

IF 1 LEN.LZ.O)  GOTO  143 

0050 

N=16-!iDEL 

3051 

IF'lN.LE.0)  GOTO  140 

0053 

M=i 

0054 

MA=  1 

0055 

I TYPE *  1 

0056 

CALL  FREEFM(N,M,NA, 1TYPE) 

0057 

IF  CN.LE.0)  GOTO  140 

0059 

DO  135  1=1, N 

0060 

135 

NDREC ( NDEL+ I ) = I NTEG (I ) 

0061 

NDEL=NDEL+N 

0062 

p 

GOTO  133 

0063 

L 

140 

CALL  riCLKFILDEF) 

0064 

IV- 1 

0065 

DEFINE  FILE  NFILE(4096,2,U, IV) 

0066 

DO  142  1=1,10,2 

0067 

142 

READ (NF ILE* IV,END=300)  HEADER( I) ,HEADER( 1+1) 

0068 

READ (NF ILE' IV, END=303) NREC 1 , NREC2 

0069 

READ (NF ILE* IV, END =303) NT I ME, NCH 

0070 

READ (NF ILE' IV, END =300) MS, MF 

0071 

NREC 1 =MAX0 ( NREC 1 , LREC 1 ) 

0072 

NREC2 =M I N0 ( NREC2 , LREC2 ) 

0073 

CALL  ATIME(KDATE) 

0074 

OR ITE (LP . 144)  (HEADER ( I) , 1=1,7) ,KDATE 

0075 

144 

F0RMAT(1HI,2X,?A2,3X, 'PROCESSED  ON  \  1202) 

0076 

URITE(LP, 145)  NREC 1 , NREC2 , NT I ME , MS , MF , NCH 

0077 

145 

F0PMATC3X. 'RECORDS* , 15,  *  TO* , 15. 

1  2X, 15,'  SECS'/ 

2  '  STARTING  CHANNEL =’ , 15, 

3  ',  FINAL  CHANNEL3' , 15, 

4  ',  CONDENSED  TO',  13,’  CHANNELS  FOR  FILTER') 

0073 

URITECLP, 143)  IQ  1 , 1 Q2 

0079 

143 

FORMAT ( '  FINAL  LEARNING  RECORDS  FOR  INPUT  VARIANCE*/ 
1  4X, 15,'  FOR  POD  1 , ' , 15, '  FOR  POD  2’/) 

0030 

UR ITE ( IOUT, 150)  (HEADER( I) , 1=1,7) ,NREC1.NREC2 

0081 

150 

FORMAT ( IX, 7A2/'  RECORDS' , 15, '  TO', 15/) 

0032 

IN  IT® 1 

0083 

LR=NREC 1- 1 
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0001 

C 

C 

0002 

0003 

0004 

0005 

O0O6 

0097 

0003 

0009 

0010 

0011 

C 

C 

c 

0012 

0014  100 

0015  110 


0016 

0017  120 

0013 
0020 

0021  130 

0023 
0024 
0025 
0026 
0027 
0023 
0029 
0030 
0032 
3033 
0034 
0035 
0037 
0039 
0041 


SUBROUTINE  KLIN(K,Y1,Y2,NR,NID,NCH..MS,MF) 

READS  IN  DATA  FOR  KALMAN  FILTER 

LAST  MODIFIED  BY  G . U. PH  ILL  IPS,  JANUARY  1935 

DIMENSION  Y1 ( 16).Y2(1S) , IY( 16) 

INTEGER  PERIOD, BLANK, HEADER ( 19) .KDATEC 12) .HDRECC 16) 

REAL  43  ALPHA, F ILDEF (5) 

COMMON  'DATA  'I DATA (33) /FREE/ 1 NTEGC 16) ,PEALX( 16) ,  ALPHA ' 16) 
COMMON-  HUR.  HEADER 
COMMON/ 10' IQ  1,  1 02 

DATA  FILDEF/8H0DEF  12  ,  1H  ,  1H..1H  ,  1H@/, IV/3/.LP/6/ 

DATA  PER  I0D/1H .  /  ..BLANK/ 1H  /,  IK/5/,  IOUT/5/, NF ILE/12/ 

DATA  IQ  1/9999/, IQ2/9999/, IELK/2H  /, IN IT/0/ 

DATA  LREC 1 /0/, LREC2/9993/, NDEL/0/ 

INITIALIZE  FILE  AND  READ  IN  HEADER 

IF ( IN  IT. NE . 0)  GOTO  200 
URITEC IOUT, 1 10) 

FORMAT ( '  FILENAME  FOR  OBSERVED  SPECTRA  (.START, STOP  RECORDS.'/ 
1  4X, ’ LAST  LEARNING  RECORDS  FOR  VARIANCE:  POD  1,P0D  2)'/) 

READ (IN, 120) LEN, IDATA 
FORMAT(Q,30A1) 

IF (LEN.LT. 1)  GOTO  100 
DO  130  1=1, LEN 

IF(IDATA( I). EQ. PERIOD)  IDATA ( I ) =BLANK 
N=2 
NA  =  1 
M=  1 

I TYPE =3 

CALL  FREEFM(N,M,NA, I TYPE) 

FILDEF(2) =ALPHA(  1) 

F ILDEFC4) =ALPHA (2) 

IF (N.LT. 2)  F ILDEF (4) “BLANK 

N=4 

M“  1 

CALL  FREEFM(N,ri,NA,  1 ) 

IF ( INTEG Cl). NE . IBLIO  LREC 1  =  INTEG ( 1 ) 

IF(INTEG(2) .NE. IBLK)  LREC2= INTEG(2) 

IF ( INTEG (3) .NE. IBLK)  IQ1=IHTEG(3) 

IF ( INTEG (4) .NE. IBLK)  IQ2=INTEG(4) 
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STORAGE  MAP 


NAME 

OFFSET 

ATTRIBUTES 

11 

000039 

INTEGERS 

ARRAY  (32) 

12 

000130 

INTEGER*? 

ARRAY  (32) 

MS 

000014 

INTEGER *2 

PARAMETER 

VARIABLE 

MF 

30001b 

INTEGERS 

PARAMETER 

VARIABLE 

NCH 

00C329 

INTEGER *2 

PARAMETER 

VAR  I  ABLE 

NFILE 

000022 

INTEGERS 

PARAMETER 

VARIABLE 

NPRT 

000024 

INTEGERS 

PARAMETER 

VARIABLE 

IV 

000026 

INTEGERS 

PARAMETER 

VARIABLE 

NREC 

003262 

INTEGERS 

VARIABLE 

NID 

000264 

INTEGERS 

VARIABLE 

MR 

00Q266 

INTEGERS 

VARIABLE 

ML 

000270 

INTEGERS 

VARIABLE 

IJ 

000272 

INTEGERS 

VARIABLE 

J 

000274 

INTEGERS 

VARIABLE 

MJ 

000276 

INTEGERS 

VARIABLE 

LI 

000300 

INTEGERS 

VARIABLE 

L2 

000302 

INTEGERS 

VARIABLE 

I 

000304 

INTEGERS 

VARIABLE 

M 

000306 

INTEGERS 

VARIABLE 

COMMON  BLOCK  /ARRAY/  LENGTH  Q04000 


DATA 


000000  INTEGERS  ARRAY  (1024) 


pi  in  r 
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0001 

c 

SUBROUTINE  DATOUT C  MS , MF , NCH , NF I LE . NPPT, IV) 

CONDENSES  NIAGARA  DATA  AND  WRITES  OUT  FOR  KALMAN  FILTER 

c 

WRITTEN  BY  G.  PHILLIPS,  JUNE  1931 

0202 

INTEGER  DATA.;  1024) ,  1 1  (32) ,  12(32) 

3003 

CCl -MON/ARRAY-'  DATA 

c 

c 

EXTRACT  OBSERVED  SPECTRA  FOR  PODS  1  AND  2 

3064 

MREC=DATA(3> 

0005 

NID=DATA( 15) 

0006 

IFCMS.LT. 3)  MS =3 

0008 

IF (MF . GT. 255)  MF-255 

0010 

p 

IF (NCH.GT.32)  NCH=32 

c 

c 

CONDENSE  SPECTRA  TO  NCH  CHANNELS 

0012 

MR=MF-M5+1 

0013 

ML  * ( MR+NCH- 1 ) /NCH 

0014 

IJ=0 

0015 

DO  160  J  =MS ,  MF ,  ML 

0016 

MJ = J+ML- 1 

001? 

IF(MJ.GT.MF)  MJ  =MF 

0019 

L1=0 

0020 

L2=0 

0021 

DO  140  I=J,MJ 

0022 

L1=L1+DATA( 1+512) 

0023 

L2=L2+DATA( I+?63) 

0024 

140 

CONTINUE 

0025 

IJ-IJ+1 

0026 

1 1 C I J )  =L  1 

002? 

12 ( I J) =L2 

3028 

160 

CONTINUE 

3029 

c 

M  =  I J 

c 

c 

200 

WRITE  TO  OUTPUT  FILE 

0330 

WRITECNFILE' IV)NREC»NID 

0031 

DO  220  1=1, NCH, 2 

0032 

220 

WRITECNFILE' IV)  I1CI), 11(1+1) 

0033 

DO  240  1*1, NCH , 2 

0034 

240 

WRITECNFILE' IV)  12 ( I ) . 12 ( I+l ) 

0035 

P 

IFCNPRT.EQ.0)  RETURN 

303? 

L 

WRITE (6, 260)  NREC.NID, C I 1 ( I ) , I = 1 ,NCH) 

0033 

260 

FORMAT ( 1X.2 14, 3 I3/(9X,3 13) ) 

0039 

WRITE (6, 280)  (12(1),  1  =  1, NCH) 

0040 

230 

FORMAT (9X, 3 18) 

0041 

RETURN 

0042 

END 

43 
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» 


C 

c 

0037  600 

0033  610 

0033 

C 


0090  300 

009  1 

0092  310 

0093 

0094 

C 

C 

C 

0095  900 

0096  910 

0098 

0099  911 

0100 

0101  920 

0103 

0104  921 

0105 

C 

0106  1000 
0107 


(JR  I  TEC  I  OUT.  6 10  ■>  MODE 

FORMAT < 1H0, ' ILLEGAL  MODEM.  14,'  CALLED  TO  TAPE  PEAD  SUBROUTINE') 
GOTO  1000 

END  OF  FILE 


NR=NR-1 

UR  ITE  < I  OUT.  310)  NR 

FORMAT ( 1H0, ' END  OF  FILE  AFTER  RECORD', 14) 

NR =9999 

RETURN 

UR ITE  ERROR  CODES 
CONTINUE 

IFCIB.NE.2)  GOTO  920 
UR  I TEC  I OUT, 91 1) 

FORMATC1H0,' TRANSPORT  NOT  OPEN') 

GOTO  1000 

IFC IB.NE.20)  GOTO  1000 
URITEC I0UT,921) 

FORMATC1H0, 'TRANSPORT  OFF  LINE') 

GOTO  1000 

STOP 

END 


MIDAS  FORTRAN  IV  STORAGE  MAP 


NAME 

OFFSET 

ATTRIBUTES 

MODE 

000014 

INTEGERS 

PARAMETER 

VARIABLE 

NR 

000016 

INTEGERS 

PARAMETER 

VARIABLE 

IOUT 

000020 

INTEGERS 

VARIABLE 

IN  IT 

000022 

INTEGERS 

VARIABLE 

MTAPEF 

000000 

INTEGERS 

PROCEDURE 

IB 

000634 

INTEGERS 

VARIABLE 

I 

000636 

INTEGERS 

VARIABLE 

ILSHFT 

000000 

INTEGERS 

PROCEDURE 

I  BCD 

000000 

INTEGERS 

PROCEDURE 

» 


COMMON  BLOCK  /ARRAY/  LENGTH  004000 

DATA  000000  INTEGERS  ARRAY  (1024) 

HEADER  000000  INTEGERS  ARRAY  (256) 


I 


42 


14  JAM  1385  11:17:33  AM 


PAGE  003 


MIDAS 

FORTRAN  IV  14  JAM  1385  11:17:33  AM 

PAGE  003 

3060 

C 

400 

p 

IF  (MODE. ME. 7)  GOTO  500 

c 

p 

D 

READ  DATA  RECORD 

URITEC  IO'JT.401)  MODE, MR 

2401 

FORMAT'! '  DAT  IN .  MODE3"  .13.*  RECORD3' .  14) 

■3 '-Jo  3 

CALL  MTAFSF'.T,  12 . 3, 2043, DATA) 

3063 

IF  C  IB.EQ. 1)  GOTO  440 

3065 

UR  I TEC  I OUT. 4 10) 13, NR 

306b 

410 

FORMAT C1H0, 'ERROR', 14.'  IM  DATA  RECORD  ', 

14) 

006? 

IF(  IB.EQ. 2. OR. IB.EQ. 20)  GOTO  903 

3069 

IF (IB.EQ. 9. OR. IB.EQ. 22)  GOTO  800 

3071 

440 

CONTINUE 

D 

IJR I  TEC  I  OUT,  441)  MR 

D441 

FORMAT'!'  RECORD',  14,'  READ  SUCCESSFULLY') 

0072 

DO  460  1=1,4 

3073 

460 

DATAC I) =ILSHFT(DATA( I) ,8) 

0074 

DO  470  1  =  1 1,  16 

0075 

470 

DATAC I) = I BCD (DATAC I) )  !  BCD 

TO  DECIMAL  CONVERSION 

0076 

DO  430  1=17, 1024 

0077 

430 

DATAC I ) = ILSHFT (DATA ( I ) , 8) 

0078 

NR=DATA(3) 

0073 

r 

RETURN 

L 

c 

c 

500 

CLOSE  TRANSPORT 

0380 

IF (MODE. ME. 10)  GOTO  600 

3332 

CALL  MTAPEFC 16, IB) 

0083 

IF C  IB. ME.  1)  I.JRITEC  IOUT,510)  IB 

0085 

510 

FORMAT ( '  ERROR'.  13.'  IN  MAGTAPE  CLOSE') 

0086 

RETURN 

MIDAS  FORTRAN  IV 


14  JAN  1935  11:17:39  AM 


PAGE 


C 

C 

3025  100 

C 
C 
C 

G027 

0029 

0G30 

0031 

0033 

0034  110 

0035 

0036  120 

0037  140 

0033 

C 

0039  200 

C 
C 

0041 

0043 

0044 

0045 

0047 

0043  210 

0049 

C 

0050  300 

C 
C 
C 

0052 

0O54 

3055 

3057 

0O53  310 

0059 


IF (MODE. NE. 4i  GOTO  200 

READ  HEADER  RECORD 

IF (NR.GT.Q)  RETURN 

CALL  MTAPEF (7, IB, 0, 5 12, HEADER ) 

NR  =  1 

IF C 18. EQ.  1)  GOTO  120 
IJR I  TEC  I  OUT,  1 10)  IB 

FORMAT ( 1 H0 » ' ERROR ',14,'  IN  HEADER  RECORD  READ') 
GOTO  900 
DO  140  1=1,3 

HEADER C 1+7) = I LSHFTC HEADER < 1+7) ,3) 

RETURN 

IF (MODE . NE .5)  GOTO  300 

SKIP  FILES  ON  TAPE 
IF (NR.EQ. 0)  RETURN 
CALL  MTAPEF (5, IB. NR) 

NR=0 

IF ( IB.EO. 1 )  RETURN 
URITEC IOUT.210) IB 

FORMAT(1H0, 'ERROR', 14.'  ON  FILE  SKIP') 

GOTO  900 

IF (MODE. NE. 6)  GOTO  400 

SKIP  RECORDS  ON  TAPE 

IF(NR.EQ.0>  RETURN 
CALL  MTAPEF (6, IB. NR) 

IF(IB.EQ.l)  RETURN 
UR ITE ( I OUT, 310) IB 

FORMAT ( 1 H0 , ' ERROR ’.14,'  IN  RECORD  SKIP') 

GOTO  900 
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0001  SUBROUTINE  DATIN (MODE, NR) 

C  NIAGARA  TAPE  READER 

C  LAST  MODIFIED  BY  G . U. PH  ILL  IPS,  APRIL  1982 

C 

0002  INTEGER  DATA (1024) . HEADER (256) 

0903  EQUIVALENCE  (DATA, HEADER) 

•3004  CO  MMO  N/P.RRA  Y/DA  T  A 

B005  DATA  IQUT/5/, IN  IT'D/ 

C 

0O0S  IF (MODE. NE. 1 )  GOTO  100 

C 

C  OPEN  AND  INITIALIZE  MAGTAPE 

C 

0003  IF ( IN  IT. Ed. 1)  RETURN 

3010  CALL  MTAPEF( 15, IB, 1) 

0011  IF(IB.NE.l)  URITEdOUT,  10)  IB 

0013  10  FORMAT ( '  ERROR". 13,’  IN  MAGTAPE  OPEN'/) 

0014  IF ( IB . HE . 20)  GOTO  30 

0016  URITEdOUT,  20) 

0017  20  FORMAT  (’  TRANSPORT  OFF  LINE'/) 

0013  STOP 

C 

0019  30  CALL  MTAPEFd,  IB) 

0020  IF(IB.NE.l)  URITE( IOUT, 35) IB 

0022  35  FORMAT ( '  ERROR', 13,'  IN  MAGTAPE  INITIALIZE'/) 

0023  IN  IT- 1 

0024  RETURN 


MIDAS  FORTRAN  IV  STORAGE  MAP 


NAME 

OFFSET 

ATTRIBUTES 

I  TEMP 

Q0O024 

INTEGERS 

ARRAY  (20) 

AFORM 

000G74 

REALM 

ARRAY  (2) 

N 

3G00 14 

INTEGER *2 

PARAMETER  VARIABLE 

M 

0863 'b 

INTEGERS 

PARAMETER  VARIABLE 

NA 

00.3820 

INTEGERS 

PARAMETER  VARIABLE 

I  TYPE 

008022 

INTEGERS 

PARAMETER  VARIABLE 

SEMI 

000104 

INTEGERS 

VAR  I ABLE 

E 

000106 

INTEGERS 

VARIABLE 

COMMA 

000112 

INTEGERS 

VARIABLE 

BLANK 

000122 

REAL*3 

VARIABLE 

IBLK1 

000110 

INTEGERS 

VARIABLE 

IBLK2 

000114 

INTEGERS 

VARIABLE 

BLNK4 

000116 

REALM 

VARIABLE 

L 

000210 

INTEGER *2 

VARIABLE 

I 

000212 

INTEGERS 

VARIABLE 

J 

003214 

INTEGERS 

VARIABLE 

JQQ 

000216 

INTEGERS 

VARIABLE 

IL 

0O0220 

INTEGERS 

VARIABLE 

ILQ 

009222 

INTEGERS 

VARIABLE 

IR 

600224 

INTEGERS 

VARIABLE 

IJ 

000226 

INTEGERS 

VARIABLE 

N I 

000230 

INTEGERS 

VARIABLE 

COMMON  BLOCK  /DATA/  LENGTH  000240 

IDATA  000000  INTEGERS  ARRAY  (30) 

COMMON  BLOCK  /FREE/  LENGTH  000340 

INTEG  00QO00  INTEGERS  ARRAY  (16) 

REALX  O0034G  REALM  ARRAY  (16) 

ALPHA  000140  REALMS  ARRAY  (16) 
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17,05  = 


3060 
QOS  1 
3062 
0063 


0064 

3065 

3066 
8067 


3068 

0070 

0071 

0073 

0074 

3075 

3076 

3077 


3078 

0879 

3080 

0081 

0082 

0083 


0084 

0085 

0086 

0087 

0038 

0089 

0090 

0091 

0092 


C 

c 

GO  TO  ( 260, 270, 280 ' . 1  TYPE 
C 

C  DECODE  INTEGER  DATA 
C 

260  ENCODE (8, 265, AFORM)  HI 
265  FORMATC' (I '  12,  ’ '  ) 

DECODE  C N I , AFORM, I TEMP  >  1 NTEG C I ) 

GO  TO  300 
C 

0  DECODE  REAL  DATA 

C 

270  ENCODE (3,275, AFORM)  HI 
275  FORMATC'  (E*  12,'  .0)  ') 

DECODE (N I, AFORM, ITEMP)  REALXCI) 

GO  TO  300 
C 

C  DECODE  ALPHANUMERIC  DATA 

C 

280  IFCNI.GT.3)  NI=8 
DO  237  J  = 1 , N I 

IF  C I TEMP (J) . EQ.SEMI)  ITEMP (J) =COMMA 
237  CONTINUE 

ENCODE ( 3 , 233 , AFORM) N I 
238  FORMAT (' (A', II,')  ’) 

DECODE (3, AFORM, ITEMP)  ALPHA ( I) 

GO  TO  308 
C 

C  BLANK  OUT  REMAINING  DATA 
C 

290  INTEG( I) =IBLK2 
REALXC I ) =BLNK4 
ALPHA ( I ) =BLANK 
300  CONTINUE 
M=M+1 
RETURN 
C 

0  BLANK  INPUT,  BLANK  OUT  ALL  DATA 
C 

400  DO  410  J= I , M 

INTEG(J) =IBLK2 
REALXC J) =8LNK4 
ALPHA(J) =BLANK 
410  CONTINUE 
M=  I 
N=M-L 
RETURN 
END 
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C 

C 

300  NR— NR 

CALL  BTIME ( I DAY, IYR, IHR, IMIN, I  SEC) 
UR  I TEC  I CRT, 302)  HR, IHR, IMIN, ISEC 
302  FORMATS  ENDING  AT  RECORD', 14, 

:•  '  .  AT  '  .  12,  '  :  '  .  12,  '  :  '  ,  12-0 

UR  I TE CLP. 3 10; 

3I0  FORMAT  II HI) 


MIMa  FO 

RTRAN  IV 

STORAGE  MAP 

NAME 

OFFSET 

ATTRIBUTES 

XI 

0800Mb 

REAL  M  ARRAY  (3) 

'•-'O 

00304b 

REALM  ARRAY  (3) 

H 

GQ9  i  Go 

REALM  ARRAY  (3) 

Q 

REALM  ARRAY  (S) 

V 1 

REAL  M  A  "RAY  (3,3)  VECTORED 

V2 

O30S0b 

REAL *4  ARRAY  (3,3)  VECTORED 

Y 1 

AO  1206 

REALM  ARRAY  (16) 

Y2 

001386 

REALM  ARRAY  (16) 

R 1 

00 1 406 

REALM  ARRAY  (16) 

R2 

001506 

REALM  ARRAY  (16) 

T1 

001606 

REALM  ARRAY  (16,16)  VECTORED 

T2 

003606 

REAL *4  ARRAY  (16,16)  VECTORED 

T3 

005606 

REALM  ARRAY  (16) 

SI 

0057Q6 

REALM  ARRAY  (16,8)  VECTORED 

S2 

006706 

REALM  ARRAY  (16,8)  VECTORED 

01 

007706 

REALM  ARRAY  (8) 

Q2 

007746 

REAL *4  ARRAY  (8) 

PI 

010006 

REALM  ARRAY  (3) 

P2 

010046 

REALM  ARRAY  (3) 

K 

010106 

INTEGERS  VARIABLE 

IN 

010110 

INTEGERS  VARIABLE 

IL 

010112 

INTEGERS  VARIABLE 

IS 

010114 

INTEGERS  VARIABLE 

IT 

010116 

INTEGERS  VARIABLE 

NR 

310120 

INTEGERS  VARIABLE 

ICRT 

010122 

INTEGERS  VARIABLE 

LP 

010124 

INTEGERS  VARIABLE 

IN  IT 

010126 

INTEGERS  VARIABLE 

KLIN 

000000 

INTEGERS  PROCEDURE 

NID 

010442 

INTEGERS  VARIABLE 

M 

0 10444 

INTEGERS  VARIABLE 

ns 

@13446 

INTEGERS  VARIABLE 

MF 

013450 

INTEGERS  VARIABLE 

KIN  IT 

000000 

INTEGERS  PROCEDURE 

N 1 

010452 

INTEGER *2  VARIABLE 

N2 

010454 

INTEGERS  VARIABLE 

BTIME 

000000 

REALM  PROCEDURE 

IDAY 

010456 

INTEGERS  VARIABLE 

IYR 

010460 

INTEGERS  VARIABLE 

IHR 

010462 

INTEGERS  VARIABLE 

IMIN 

010464 

INTEGERS  VARIABLE 

ISEC 

010466 

INTEGERS?  VARIABLE 

L 

010470 

INTEGERS  VARIABLE 

KSTEP 

000000 

INTEGER •*'2  PROCEDURE 

DDKALM 

000000 

REALM  PROCEDURE 

IER 

010472 

INTEGERS  VARIABLE 

J 

010474 

INTEGERS  VARIABLE 

I 

010476 

INTEGERS  VARIABLE 

KOUT 

000000 

INTEGERS  PROCEDURE 

MOD 

000000 

INTEGERS?  PROCEDURE 

52 


ND  66m  LINKER 


V02-A-1 


LOAD  MAP 
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SECTION 

ADDR 

SIZE 

ENTRY 

ADDR 

ENTRY 

ADDR 

ENTRY 

ADDR 

.  ABS. 

000000 

C00000 

SLRECL 

009210 

SNLCHN 

000006 

SUSRSU 

000090 

SRF1B3 

000000 

.  ABS . 

00OOO0 

300000 

STRACE 

004737 

.  ABS . 

000800 

000000 

SV004A 

00000 1 

.  3S3S .  & 

020803 

300090 

.$$5$. 

020000 

020003 

312522 

032522 

035754 

KIN  IT 

032522 

04347b 

003762 

KLIN 

040476 

0444S0 

032364 

DDKALM 

044460 

047044 

007542 

KOIJT 

047044 

056606 

001326 

KSTEP 

056606 

060134 

000372 

LIB  IN 

060134 

060526 

000452 

VMULFF 

060526 

061200 

000436 

VMULFP 

061200 

061636 

000362 

LEQT1F 

061636 

062220 

003554 

LUDATF 

062220 

065774 

008760 

LUELMF 

065774 

066754 

002026 

IJERTST 

066754 

071002 

002106 

FREEFM 

071002 

073110 

000146 

XFFS 

073118 

SPURR 

0731 10 

073256 

000063 

NMISII 

073256 

NMISMI 

073304 

NMISPI 

073312 

NPISII 

073322 

NPISMI 

073326 

NPISP1 

073332 

073336 

000064 

NMISIP 

073336 

NMISMP 

373370 

NMISPP 

073376 

NPI5IP 

073406 

NPISMP 

073412 

NPISPP 

073416 

073422 

000044 

NMISIP 

073422 

NPIS1I 

073442 

NPIS1M 

373454 

NPIS1P 

073436 

073466 

000142 

SORT 

073466 

073630 

000350 

EXP 

073630 

074200 

000360 

ALOG 

074204 

ALOG 10 

074200 

074560 

000262 

XFIS 

074560 

SPUR  I 

074560 

075042 

000040 

MOD 

875042 

075102 

000110 

TADS 

075132 

TAFS 

075140 

TA  IS 

075102 

TAL3 

075110 

TAPS 

075124 

TAGS 

075116 

075212 

000020 

STKSF 

075222 

STKSI 

075216 

STKSL 

073212 

075232 

000056 

SOT  IS 

075232 

075310 

000210 

ISNS 

075310 

LSNS 

075330 

SISNTR 

075314 

SLSNTR 

075334 

075520 

000034 

ENDS 

075520 

ERRS 

075536 

075554 

000046 

EOLS 

075554 

075622 

000066 

DEOS 

075622 

075710 

000044 

RETS 

075724 

RETSF 

075714 

RETS  I 

075722 

RETSL 

075710 

075754 

001106 

IBRS 

075762 

I  BUS 

075754 

SIBU 

075766 

077062 

000072 

ENCS 

077062 

077154 

000020 

IFRS 

077154 

IF  US 

077166 

077174 

001562 

SFIO 

077662 

100756 

002344 

DCOS 

102402 

ECOS 

102374 

FCOS 

102370 

GCOS 

102362 

ICIS 

100764 

ICOS 

102136 

OCIS 

100756 

OCOS 

102130 

RC  IS 

181160 

SGET 

101144 

103322 

000036 

CFDS 

103322 

SDR 

103322 

103360 

000110 

SDUMPL 

103360 

103470 

030036 

SGETF I 

103470 

103526 

000042 

D I  ISIS 

103540 

D1 ISMS 

103534 

D I  ISPS 

103526 

DIISSS 

103542 

SDVI 

103542 

103570 

000040 

MU  ISIS 

103602 

MU  I SMS 

103576 

MU  ISPS 

103570 

muisss 

103604 

SML I 

103694 

103630 

000130 

CICS 

1G3630 

C  IDS 

103630 

CIFS 

103340 

CILS 

103752 

CLCS 

103630 

CLD3 

103630 

CLFS 

103640 

CL  IS 

103756 

3D  I 

103630 

SRI 

133640 

103760 

000120 

SFCHNL 

103760 

104100 

000044 

E'EQS 

194120 

BGES 

104130 

BGTS 

104126 

BLES 

1041 16 

BLTS 

104140 

BNES 

104136 

ERAS 

104132 

NMIS1 I 

1041 10 

NMIS1M 

104100 

104144 

000002 

SAOTS 

104144 

104146 

000100 

CCIS 

104146 

GDIS 

104146 

CF  IS 

104162 

SIC 

104146 

SID 

104146 

SIR 

104162 

104246 

000016 

SFCALL 

104246 

104264 

000012 

SUAIT 

104264 

104276 

000044 

JMCS 

104304 

JMISM 

104300 

JMISP 

104276 

104342 

300030 

ANBS 

104346 

EQVS 

104354 

IORS 

104342 

XORS 

104356 

104372 

000036 

CA  IS 

104372 

CALS 

104400 

104430 

000024 

MAX0 

104430 

104454 

000024 

MIN0 

104454 

104500 

000316 

ABS 

104500 

104516 

000016 

MO  I SR A 

104530 

MOISRM 

104522 

MOISRP 

104526 

MO  I SR S 

104516 

MOLSRS 

104516 

104534 

000102 

moisia 

104560 

MOISIM 

104554 

MOISIS 

104550 

MOISMA 

104574 

MOISMM 

104570 

MO  I SMS 

104564 

MOISSA 

104544 

MOISSM 

104540 

MOISSS 

104534 

MO  ISO A 

104610 

MOIS0M 

104604 

MO  I SOS 

104600 

MOISIA 

104630 

MOISIM 

104622 

MOISIS 

104614 

MOLSIS 

104550 

MOLSSS 

104534 

RELS 

104550 

104636 

300046 

CMISIP 

104636 

CMISMP 

104646.  CM  ISP  I 

104670 

CMISPM 

104676 

CMISPP 

104656 

CM ISPS 

104562 

cmissp 

104640 

104704 

000044 

CM I SI  I 

104724 

CM I $ I M 

104730 

CMISIS 

104720 

CM  I SMI 

104740 

CMISMM 

104744 

CM I SMS 

104734 

CMISSI 

104710 

CMISSM 

104714 

CMISSS 

104704 

104750 

000016 

NG  ISA 

104762 

NG  ISM 

104754 

NG  ISP 

104760 

NGISS 

104750 

104766 

000034 

DC  ISA 

105016 

DC  ISM 

105010 

DC  ISP 

105014 

DCISS 

105004 

ICISA 

105000 

ICISM 

104772 

ICISP 

104776 

ICISS 

104766 

105022 

000046 

SUISIP 

105022 

SUISMP 

105036 

SUISPA 

105062 

SUISPM 

105054 

SUISPP 

105032 

SUISPS 

105046 

SUISSP 

105024 

105070 

000044 

SUISIA 

105110 

SIJISIM 

135114 

SUISIS 

105104 

SUISMA 

105124 

SUISMM 

105130 

SU I SMS 

105120 

SUISSA 

105074 

SUISSM 

105130 

SUISSS 

105073 

105134 

000046 

ADISIP 

105134 

ADISMP 

105150 

AD  I  SPA 

105174 

ADISPM 

105166 

ADISPP 

105144 

AD  ISPS 

105168 

ADISSP 

1 05 1 36 

105202  000044  ADISIA  105222 
ABISMA  105236 
ADI3SA  105206 
105246  800064  (101$ IP  135246 
MO  1 5PM  105300 
MOISSP  135250 
105332  OO0 1 7 d  CMF5II  105406 
CMF3IS  195352 
CM^SMP  105430 
CMP  5Pr1  125434 
CMF53I  135412 
CMFSS3  195360 
105326  000026  MQFSRA  105544 
M0F5RS  105526 
105554  000012  MOFSSS  105554 
105566  000014  MQF3IS  105566 
105602  000016  MO F SMS  105602 
105620  000014  M0FS3A  105620 
105634  000010  MOFSIA  105634 
105644  000014  MOFSSM  105644 
105660  000020  MOFSIM  105660 
105700  000020  M0FS0A  105710 
105720  000042  MOFSMA  105732 
MOFSPA  105752 
105762  000054  SAISPM  105762 
SVISPP  106022 
106036  000032  SAISIP  106036 
SVISIP  106046 
106070  000032  SAISIM  106070 
SVISIM  106100 
106122  000032  TSDSI  106142 
TSDSS  106126 
TSFSP  106146 
TSISM  106136 
106154  000034  CPB33M  106176 
CPLSSM  106154 
105210  O00O30  LEGS  106212 
LLES  106210 
106240  000024  TSLSI  106250 
TSLSS  106240 
106264  000044  SAFSIP  106264 
SVFSIP  106276 
106330  000044  SAFSIM  106330 
SVFSIM  106342 
106374  000036  NGBSA  106426 
NGDSS  106374 
NGFSP  106422 
106432  000030  MOBSMS  106442 
MODSVS  106444 
106462  000046  MODSMA  106512 
MOBSPA  106506 
106530  000020  MODSSM  136534 
106550  300044  SABSIM  106550 
SVBSIM  186564 


ADI3IM  105226  ADISIS  105216 
ADISMM  105242  AB1SMS  105232 
ADISSM  105212  ABISSS  105202 
MQI3MP  105262  MO  I SPA  105306 
M01SPP  105256  MOISPS  105272 
MOIS0P  105314  M01S1P  105322 
CMFS1M  1Q5470  CMFSIP  105440 
CMFSMI  105376  CMFSMM  105460 
C Mr SMS  105336  CMFSPI  135372 
CMF3PP  105424  CMF3PS  105332 
CMFSSM  135474  CMFSSP  135444 
SCMR  105368 

MOFSRM  195534  MOFSRP  105550 


MQFS0S  105574 
MOFSPS  185614 


MOFSSP  105654 
MOFSIP  185672 

MOFS0M  105700  MOFS0P  105714 
MOFSMM  105720  MOFSMP  105740 
MOFSPM  105746  MOFSPP  105756 
SAISPP  106010  SV’ISPM  105774 

SAISMP  106060  SAISSP  106040 
SVISMP  106064  SVISSP  106050 
SAISMM  136112  SAISSM  106072 
SVISMM  106116  SVISSM  106102 
TSDSM  106136  TSBSP  106146 
TSFSI  106142  TSFSM  106136 
TSFSS  206132  TSISI  106142 
TSISP  186146  TSISS  186122 
CPFSSM  106 164_  CPISSM  106160 

LGES  106222  LGTS  106220 
LLTS  106234  LMES  106232 
TSLSM  106244  TSLSP  106256 

SAFSMP  106320  SAFSSP  106266 
SVFSMP  106324  SVFSSP  106300 
SAFSMM  106364  SAFSSM  106332 
SVFSMM  106370  SVFSSM  106344 
NGBSM  106406  NGDSP  106422 
NGFSA  106426  NGFSM  106406 
NGFSS  106374 

M0DSP3  106436  MOBSSS  106432 

MOBSMM  106500  MODSMP  106466 
MOBSPM  106474  MOBSPP  306462 
MOBSSP  106530 

SABSMM  1O6604  5AB3SM  106552 
3VBSMM  106610  SVBS3M  106566 
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106614 


106614  000016  CCFS  106614  CDFS  106614  SRC 
SRD  106614 

106632  001166  ADDSIS  106702  ADDSM3  106662  ADDSPS  106656 
ADDSSS  106730  SUDS IS  106714  SUDSMS  106636 
SUDSPS  106632  SUDSSS  106724  SADD  106730 
SSBD  106724 

110020  O00074  SADSPM  110020  SADSPP  110056  SVDSPM  110936 


SVB5PP 

1 10974 

APFAY  3, 

110114 

004090 

ARRAY 

1 10114 

ARRAY  & 

1 10114 

004009 

HEAD  3. 

114114 

000200 

HEAD 

114114 

HEAD  8, 

1 141 14 

000200 

DATA  8. 

1 14314 

030249 

DATA 

1 14314 

DATA  8. 

1 14314 

000240 

DATA  8. 

114314 

000240 

FREE  8, 

1 14554 

000340 

FREE 

114554 

FREE  8, 

114554 

000340 

FREE  8. 

1 14554 

000340 

HDR  8, 

115114 

080024 

HDR 

115114 

HDR  & 

115114 

000024 

IQ  a, 

115140 

000004 

IQ 

115140 

IQ  8, 

1 15140 

000004 

IQ  8. 

1 15140 

000004 

ATIMES 

115144 

000100 

AT  I  ME 

115144 

BTIMES 

1 15244 

000103 

BTIME 

1 15244 

MCLIS 

1 15344 

000632 

MCL I 

1 15344 

SM.TVT 

116176 

000062 

TVDS 

116212 

TVFS 

116204 

TVIS 

116234 

TVLS 

116176 

TVPS 

116226 

TVQS 

116220 

OT 

116260 

001510 

SERRSS 

116770 

SFPERR 

116632 

SOT  I 

116260 

STOP 

1 17770 

000112 

EXIT 

120014 

FOOS 

127770 

STPS 

120014 

RIO 

120102 

000600 

DEFS 

120616 

IRRS 

120102 

IRUS 

120106 

SGETIN 

120466 

GETREC 

120702 

000346 

SGETRE 

120702 

STTYIN 

121202 

ENDFIL 

121250 

000042 

EOFS 

121250 

GLOSS 

121312 

000550 

SCLOSE 

121312 

SM.RMM 

122062 

000179 

A  MAXI 

122104 

AMIN  1 

122062 

MAXI 

122072 

MINI 

122066 

0UTREC 

122252 

000414 

SPIJTRE 

122252 

SM.FIO 

122666 

900216 

SFMTDR 

122666 

SFMTDU 

122722 

SINITI 

122774 

OPEN 

123104 

000610 

SOPEN 

123104 

FADD 

123714 

000062 

ADFSIS 

123714 

ADFSMS 

123726 

ADFSPS 

123722 

ADFSSS 

123720 

SUFSIS 

123742 

SUFSMS 

123754 

SUFSPS 

123750 

SUFSSS 

123746 

SADR 

123720 

SSBR 

123746 

FDIV 

123776 

000034 

DIFSIS 

124014 

DIF  SMS 

124002 

DIFSPS 

123776 

DIFSSS 

124020 

SDVR 

124020 

FMUL 

124032 

000034 

MUFSIS 

124050 

MUFSMS 

124036 

MUFSPS 

124032 

MUFSSS 

124054 

SMLR 

124054 

RUBLK 

124866 

300460 

SEOFIL 

124476 

SGETBL 

124310 

SPIJTBL 

124065 

ERRTB 

124546 

000 100 

SERRTB 

124546 

ERRS 

124646 

002570 

SERRS 

124646 

SM.LCV 

127436 

000106 

LC  IS 

127436 

LCOS 

127504 

ADDM 

127544 

000116 

ADFSIM 

127544 

ADFSMM 

127556 

ADFSPM 

127552 

ADFSSM 

127566 

SUFSIM 

127602 

SUFSMM 

127636 
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SLIF$PM  127632  SUF3SM  127610 

ADDP  127662  000114  ABF3IP  127662  ADF3MP  127674  ADF3PP  127670 

ABF3S?  127704  SUFSIP  127720  SUFSMP  127754 
3UFSPP  127750  SUFSSP  127726 

ADDA  127776  000150  ADF51A  127776  ADFST1A  130030  ADF3PA  130024 

ftDFSSA  130096  SUF5IA  130054  SUF5MA  139110 
3UF3PA  130104  SUF33A  1390S2  3FPAR  133050 
SFPSR  130130 


SEGMENT  PARAMETER  TABLE 

SEG  SIZE  LIMIT 
0  110146  130146 

PROGRAM  SIZE  =  110146 
DATA  AREA  SIZE  =  000000 
TRANSFER  ADDRESS  =  020000 
STACK  SIZE  =  001000 
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0001  SUBROUTINE  KINIT(X1,X2,Y1,Y2,H,V1,V2,P1,P2,Q1.Q2. 

1  S1,S2,N1,N2,M.MS.MF) 

C  INITIALIZES  KALMAN  FILTER  FOR  NIAGARA  DATA 

C  LAST  MODIFIED  BY  G.U.PHILLIPS,  MARCH  1932 

C 

0002  COMMON/APR AY/ARPAY 1512) 

0003  COMMO;  l/HEAD/HDR 1 13) , HDR2 13) 

0004  REALMS  HDR 1 , HDR2 

0005  REAL:!'-4  X1 13) .. X2 1 3 ) , Y 1 1 16) ,Y2( 16)  ,S1  <  16.3)  ,S2>.  16,3) 

0006  P.EAL:k4  P 1 (3) ,P°  <3) , Q 1 (3) ,Q2 (3) , H18) , VI (3,8) , V2 (3,3) 

0007  INTEGER  CRT, DATA, PERIOD, BLANK, COMMA 

0008  COMMON/DATA/DATA<30)/FREE/INTEG(16),REALXC16),ALPHA( 16) 

0009  REAL*8  FILDEF (5) , ALPHA, ABLANK 

0010  DATA  FILDEF/3H0DEF  3  , 1H  ,1H..1H  , 1H@/, ABLANK/3H 

0011  DATA  CRT/5/, LP/6/» IN/5/, I0UT/6/,PERI0D/lH./.BLANK/lH  / 

0012  DATA  COMMA/ lH,/,LUF/3/ 
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0013 

c 

103 

N 1  =0 

0014 

'.■JR  ITE  (CRT,  1 10) 

0015 

1  10 

FORMAT Cl HQ.’ INPUT  POD  1  LIBRARY  SPECTRA’/ 

9016 

1  IX, 'FILENAME, COUNT  TIME, REL.  INTENS. (.FRACT.  ERROR)’/ 

2  IX, ’TERMINATE  WITH  CCR)') 

'.JR  ITE ( I GUT,  112) 

3C17 

1 12 

FORMAT'.  1H0,  'POD  1  LIBRARY' ) 

0C  IS 

129 

M 1 -N 1 + 1 

0019 

UR ITE (CRT, 130) Ml 

0020 

130 

FORMAT ( IX, 13,$' 

0021 

READ (CRT, 140)LEN,DATA 

0022 

149 

FORMAT (Q, 80A 1 ) 

0023 

IFCLEN.LT. 1)  GOTO  198 

0025 

URITEdOUT,  142)  N 1 ,  (DATA ( I ) ,  I  -  1 , LEN) 

0G2S 

142 

FORMAT ( 1H0, I5,2X,80A1) 

0027 

DO  150  1=1, LEN 

0028 

IF (DATAC I) ,EQ. COMMA)  GOTO  152 

0030 

IF (DATA ( I) .EQ. PERIOD)  DATA ( I ) =8LANK 

0032 

150 

CONTINUE 

0033 

152 

NX=2 

0034 

MX=  1 

0035 

NAM 

0036 

CALL  FREEFMCNX, MX, NA , 3) 

0037 

FILDEF (2) =ALPHA( 1) 

0033 

FILDEFC4) =ALPHA(2) 

0039 

HDR 1 CN 1 ) “ALPHA ( 2 ) 

0040 

IF (NX.EQ.2)  GOTO  153 

0042 

HDR1 CNl) “ALPHA ( 1) 

0043 

FILDEFC4) “ABLANK 

0044 

153 

CALL  MCL I (FILDEF) 

0045 

NX-3 

0046 

MX- 1 

0047 

CALL  FREEFMCNX, MX, HA, 2) 

0043 

FX ■ ! 0 . /REALX ( 1 ) 

0049 

XI (Nl) =REALX(2) 

0050 

PI (Nl) =1 

0051 

C 

IF (NX. EQ . 3)  PI (Nl) =REALX(3)**2 

59 
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C 


0953 

MI =256 

0054 

CALL  LISIMCLUF.MI) 

D 

UR  I TE  LP ,  155'1  N  i ,  (ARRAY!  I ) ,  1  =  1, MI) 

D  155 

FORMAT ( '  POD  1 ,  LI BP  ARY  MEMBER ’ ,13/(10013.3)) 

9055 

IFlMI.GE.MF)  GOTO  169 

0057 

..RITE (CRT,  156)  Ml. MI 

0053 

156 

FORMAT ( IX, ' L IBRAR'  MEMBER' . 14,'  SHORT,  LENG TH=' , : 4/) 

0059 

169 

ML  = (MF-MS+M) /M 

D 

l JR  I  TE  i.  CRT,  1 62 )  PI,  MS ,  MF ,  ML 

D 162 

FORMAT ( 1 H0 , ' M, MS , MF , ML  = ' , 4 ( 14, ' , * ) ) 

0060 

Q 1 (N 1 ) =0 . 

0061 

I  J=0 

0062 

DO  130  J  =MS , MF , ML 

0063 

MJ  =  J+ML- 1 

0064 

IF(MJ.GT.MF)  MJ  =MF 

0066 

SUM=0 . 

0067 

DO  170  I  =J,  MJ 

0068 

170 

SUM=SUM+ARRAY( I) 

0963 

SUM=FX*SUM 

0070 

I  J  =  IJ+1 

0071 

3 1  ( I  J, N 1 ) =SUM 

0072 

Q1(N1)=Q1(N1)+SUM 

0073 

180 

CONTINUE 

0074 

IJRITEdOUT.  182)  CSKI.N1),  1  =  1, M) 

0075 

182 

FORMAT! 1H0. 'CONDENSED  SPECTRUM' ,80 13, 3/( 19X, 8G 13.3) ) 

0076 

r 

GOTO  120 

0077 

190 

N 1 =N 1-  1 

00?a 

IJRITEdOUT,  192)  (Old),  1  =  1, Nl) 

0079 

192 

FORMAT  d  H0 , ’ GRANBSUMS : ' . 3G 1 3 . 3/ d  0X. 3G 1 3 . 3) ) 

C 
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0680  2Q0  N2=0 

3031  Lh  HE  (CRT, 2 10) 

grp";  FORMAT*.  1KQ.  ’  INPUT  POD  2  LIBRARY  SPECTRA'/ 

1  IX, 'HLEMAME. COUNT  TIME, PEL.  INTEHS. (,FRACT . 

2  1 !  -I.  •  TERM  I  NATE  U I TH  ( CR)  ' ) 

r.r-03  i.PITEC  IQUT.212'1 


ERROR) ’/ 


5004 

2 12 

FORi  1AT  i.  1  HO .  •  POP  2  LI  BPARY  ’ ) 

0035 

220 

M2  =N2+ 1 

3036 

I..JR  1 7E  >. CRT,  230 )  H2 

3037 

230 

FORMAT ( IX, 13,  S) 

0038 

READ' CRT, 240) LEN, DATA 

0039 

249 

FORMAT (Q.80A 1 > 

0090 

IFCLEH.LT. 1)  GOTO  290 

0092 

1.JR  I  TEC  I  OUT,  242)  N2,  (DATA(I),  1  =  1.  LEI 

0093 

242 

FORMAT ( 1H0, I5.2X.30A1) 

3094 

DO  250  1=1, LEN 

0095 

I F C DATA (I ) . EQ . COMMA )  GOTO  252 

0097 

IF (DATA (I) .EQ. PERIOD)  DATA< I) =BLAN! 

0099 

250 

CONTINUE 

0100 

252 

NX =2 

0101 

MX=  1 

0102 

NA=  1 

0103 

CALL  FREEFMCNX, MX, NA, 3) 

0104 

F  ILDEF(2) "ALPHA ( 1 ) 

0195 

FILDEFC4) "ALPHA (2) 

0106 

HDR2CN2) =ALPHA(2) 

0137 

IF (NX.EQ.2)  GOTO  253 

0139 

HDR2CN2) "ALPHA ( 1 ) 

0110 

F ILDEF (4) "ABLANK 

0111 

253 

CALL  MCLKF  ILDEF) 

0112 

NX"  3 

3113 

MX"  1 

0114 

CALL  FPEEFM(NX, MX, NA . 2) 

9115 

FX= 10 . /REALXt 1 ) 

0116 

X2(N2) =REALX(2) 

0117 

P2CN2) =1 . 

0113 

IF (NX.EQ.3)  P2(N2)=REALX(3)**2 
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'J  120 

C 

c 

MI =256 

3121 

CALL  LISIN' LUF, MI) 

n 

UR  IT2 1  LP .  255!' N2 .  (ARRAY'  p  .  1  =  1, MI) 

r,255 

FORMAT  ;  *  POD  2,  L  I 3P  AR  Y  MEMBER ’ ,  I 3/ C 1 OG 1 3 . 3 ) ) 

J  1  °2 

IF1  M 1 . 6E .  riF  '  GOTO  260 

3124 

IJP  ITE  (CRT . 256)  N2.MI 

3125 

256 

FORMAT IX,  -LIBRARY  MEMScR'  ,  14,  *  SHORT,  LENGTH- '  -  14/) 

3126 

260 

ML- ' MF-M3+M) -■  M 

D 

UR  I TE ( CRT, 262 )  M -  MS , MF , ML 

D252 

FORMAT'!  1H0 ,  ’  M . MS ,  MF ,  ML  =  *  ,4(  14,  ’ »  ' ) ) 

0127 

02 (N2) =0. 

0123 

IJ=0 

0129 

DO  230  J  =MS ,  MF ,  ML 

0133 

MJ-J+ML-1 

3131 

I F ( MJ . GT . MF  j  MJ -MF 

0133 

SUM-0. 

0134 

DO  270  I -J, MJ 

0135 

270 

SUM-SUM+, ARRAY ( I) 

0136 

SUM=FX*SUM 

9 1 37 

IJ-IJ+1 

0133 

S2( I J,N2) -SUM 

0139 

Q2CN2) =Q2(N2)+SUM 

9140 

2S0 

CONTINUE 

0141 

UR ITE (I OUT, 232; (S2< I.N2) , 1=1. M) 

0142 

232 

FORMAT'!  1H0,  'CONDENSED  SPECTRUM' ,8G 13.3/ < 19X,8G13.3) ) 

0143 

p 

GOTO  220 

0144 

230 

N2-N2-1 

0145 

UR  I  TEC  I  OUT.  292)  (Q2C I) ,  I-1..N2) 

9146 

292 

FORMAT'!  1H0  . '  GRANDSUM3 ’ , 3G  13 . 3/<  10X,  8G 13 . 3) ) 

C 


dd  o  o  tr>  OJ 
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-u 
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60 


300  SUMY 1=0. 

SUm  2  =3. 

DO  320  J  =  1 , M 
SUMY  1  =SU i'v'  1  -r  f  1  ( J ) 

SUMY2=SUriY2-rY2(J  « 

20  CONTINUE 
SUi  fYl=3. 

DO  340  1=1, Ml 

40  SU  MY  1  =S  U  MX  1  +',<  1  'll )  *Q  1 C I  ) 

UP  I TE ( CRT, 34 1 ) SUMY 1 , SUMX 1 , ( I . XI ( I ) , Q 1 ( I ) , I  =  1 . N 1) 
341  FORMAT ( '  P0D1:  SUMY-' ,G 13.3, ' ,  GRANDSUMX-* , G13.3/ 
1  (110, 2G 2 3. 31) 

XUCRM 1 -SUMY 1 /SUMX 1 
SUMX2-0. 

DO  360  1=1, M2 

S3  SIJMX2  -SUMX2+X2  (I)*Q2(n 

UP  I TE ( CRT, 36 1 ) SUMY2 , SUKX2 , ( I , X2 ( I ) , Q2 ( I ) , 1 = 1 , N2 ) 
361  FORMAT ( '  P0D2*  SUMY*' ,G13.3. ' ,  GRANDSUMX=’ , G 13 . 1/ 
1  ( 1 10, 2G 13 . 3) ) 

XH 0 R  M2 = S I  j  MY2 /S U MX2 


n  !•>  ~T  in  'f>  f  -  03  >Tt  CD  Cl  m  rj  in  CO  r--  CD  C r.  CD 
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C 
C 

■•so  do  420  :  =  i.ni 

xi  <  i  :•  =X1 1  )  XTJOPMl 

o  i ;  •'  =pi  i.  n  * 

p  :  i. :  =p  i .  i  >  *xi  1. 1 

V  1  !  I  .  I  ■  =p  :  r  I  I 
42Q  CONTINUE 

DO  440  ! = 1 , N2  -  .. 

X2(  I)  =X2C  I)*XN0RM2 

Q2'I)=P2(I)  % 

P2  ( I ) =P2 ( I )  kX2 ( I ) **2  w 

V2 (1,1 ) =P2 ( I ) 

440  CONTINUE 

UP  I  TEC  I  OUT,  442 )  CXI  CD,  1  =  1,  HI) 

442  FORMATC 1H0,' INITIAL  INPUT  VECTORS'/ 

1  IX, 'POD  l’,3G13.3/C?X,3G13.3) ) 

UR  I  TEC  I OUT, 444) CX2C I) , I  =  1 ,N2)  | 

444  FORMATC IX, 'POD  2' , 3G 13. 3/C7X, 3G13 . 3) ) 

C 

N=MAX8 (N 1 , N2) 

DO  430  I  =  1 , N 
H  C I )  =  1 . 

430  CONTINUE 

C  I 

31  500  RETURN 

32  END 


> 


» 


» 


> 
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IE  (Binary  Time)  Subroutine 

BTJME  subroutine  is  used  to  return  to  the  user  the  binary  time.  This 
'outine  is  written  in  Assembler. 

i 

.  BTIME  (a,b,c,d,e) 
re: 

Integer  to  receive  the  Julian  date. 

Integer  to  receive  the  year. 

Integer  to  receive  the  hour. 

Integer  to  receive  the  minutes. 

Integer  to  receive  the  seconds, 

e 

the  parameter  count  is  <5  or  >5,  then  an  exit  is  made  to  MIDAS. 
mple 

EGER  A.B.C.D.E 

.L  BTIME  (A,B,C,D,E) 


L/A 
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■  c 

lO' 22b 

INTEGERS 

VARIABLE 

I  BLANK 

001220 

INTEGER *2 

VARIABLE 

:  itaa 

00 ’ 222 

INTEGER +-2 

•■•ARIABLE 

~  P  ^ 

002 2 ’b 

■SAL  --4 

PROCEDURE 

002262 

-ZAL  i-4 

VAR  TABLE 

"r;  ! 

-EHl.  4 

poC'CE3  'PE 

~  “  n 

■  o  _  _  -*»_• 

- :-4 

PcOCELUPE 

I :—  L' 

-2 ' :  _  2  "6 

72A'_  -4 

h13  I  -,f3!_E 

7  0  7"?  00 

r'Er*_  '  4 

RPCCEDCRE 

4_  , 

002272 

-E  iL  --4 

hRIhELE 

: 

o  0  7. 3  TV 

PEAL  >-4 

'■  AP  i  able 

AL  Zj 

J  U  -  4'v 

PEAL  ■  4 

VAR IABLE 

5733 

002406 

5EAi_  i'-4 

VARIABLE 

SOP  5 

002412 

P  EAL  *4 

VARIABLE 

NM1 

002416 

I NTEGER*2 

VAR IABLE 

1 

302420 

INTEGER  *2 

'-■ARIABLE 

SIG 

302422 

REAL *4 

VAR  IABLE 

SIG3 

002426 

PEhL  *4 

VAR  IABLE 

SIG5 

002432 

REAL  i-4 

VAR  I  ABLE 

NM2 

002436 

INTEGER *2 

'.'ARIABLE 

U1 

0024.40 

REAL  *4 

VARIABLE 

U2 

302444 

REAL  *4 

VAR IABLE 

CHU1 

302430 

PEAL  i-4 

VAR1 I ABLE 

J 

002454 

INTEGER*'! 

VAR  I  ABLE 

AMAX1 

000000 

PEAL  *4 

PROCEDURE 

ICHFL1 

002456 

INTEGERS 

VAR IABLE 

XCH1 

002460 

REAL  *4 

-ARIABLE 

CHIJ2 

002-464 

aEAl  *4 

-’AR  !  ABLE 

ICHFL2 

002420 

INTEGER  1-2 

VAR IABLE 

XCH2 

002422 

PEAL  *4 

VARIABLE 

ATIME 

000000 

REAL  *4 

PROCEDURE 

NU1 

002476 

INTEGER  *2 

VAR  I  ABLE 

NIJ2 

002500 

INTEGERS 

VARIABLE 

COMMON 

E-LOCK  HEAD  LENGTH  000200 

ADR  1 

000000 

rEbL  0 

ARPA  ' 3  1 

HDR2 

000100 

REAL  *3 

ARRAY  (3J 

COMMON 

BLOCK  /HDR/  LENGTH  000024 

HEADER 

000000 

INTEGERS 

ARRAY  (10) 

COMMON 

BLOCK  /IQ/  LENGTH  000004 

IQ  1 

000000 

INTEGER*2 

VARIABLE 

IQ2 

000002 

INTEGERS 

VARIABLE 

76 
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NAME 

'<DhTE 

XI 


P2 
Q  1 
02 
Y1 
Y2 
R 1 
R2 

51 

52 
A IX 
A  1SQ 
A 1 3 
A 15 
A2X 
A2SQ 
A23 
A25 
XNM1 
XNM2 
VAR  1 
VAR  2 
XH1 
XH2 
SIG1 
SIG2 
J1FLAG 
J2FLAG 
[HEAD 
AHEAD 
K 

NR 

NID 

N 1 

N2 

M 

MS 

MF 

A  MX 

AM3 

AM5 

MNM 

THRESH 

THSIG 

I  1 

12 


OFFSET 

ATTRIBUTES 

008064 

INTEGERS 

ARRAY  (12) 

300022 

REAL  M 

PARAMETER 

ARRAY 

(3) 

000324 

REAL  *4 

PARAMETER 

ARRAY 

(3) 

680026 

REAL  M 

PARAMETER 

ARRAY 

(3) 

030030 

REAL  *4 

PARAMETER 

ARRAY 

(3) 

090G42 

REALM 

PARAMETER 

ARRAY 

(3) 

000044 

REALM 

PARAMETER 

ARRAY 

(8) 

000032 

REALM 

PARAMETER 

ARRAY 

(16) 

O00O34 

REALM 

PARAMETER 

ARRAY 

( 16) 

000O4S 

REALM 

PARAMETER 

ARRAY 

(lb) 

000050 

REALM 

PARAMETER 

ARRAY 

(16) 

000036 

REALM 

PARAMETER 

ARRAY 

( 16, 

000040 

REALM 

PARAMETER 

ARRAY 

( 16, 

0001 14 

REALM 

ARRAY  (3) 

000154 

REALM 

ARRAY  (3) 

000214 

REALM 

ARRAY  (3) 

000254 

REALM 

ARRAY  (3) 

000314 

REALM 

ARRAY  (3) 

000354 

REALM 

ARRAY  (8) 

000414 

REALM 

ARRAY  (3) 

003454 

REALM 

ARRAY  (8) 

000514 

REALM 

ARRAY  (3) 

000554 

REALM 

ARRAY  (3) 

000614 

REALM 

ARRAY  (3) 

000654 

REALM 

ARRAY  (3) 

009714 

REALM 

ARRAY  (3) 

000754 

REALM 

ARRAY  (8) 

001914 

REALM 

ARRAY  (3) 

001054 

REALM 

ARRAY  (8) 

00!  1  14 

INTEGERS 

ARP AY  (3) 

301134 

INTEGERS 

ARRAY  (3) 

©0 i 154 

INTEGERS 

ARRAY  (6) 

091154 

REALM 

ARRAY  (2) 

000014 

INTEGERS 

PARAMETER 

VARIABLE 

000016 

INTEGERS 

PARAMETER 

VARIABLE 

000020 

INTEGERS 

PARAMETER 

VARIABLE 

000052 

INTEGERS 

PARAMETER 

VARIABLE 

000054 

INTEGERS 

PARAMETER 

VARIABLE 

000056 

INTEGERS 

PARAMETER 

VARIABLE 

000060 

INTEGERS 

PARAMETER 

VARIABLE 

000062 

INTEGERS 

PARAMETER 

VARIABLE 

00 1 1 74 

REALM 

VARIABLE 

001200 

PEALM 

VARIABLE 

061204 

REALM 

VARIABLE 

001210 

INTEGERS 

VAR  I ABLE 

001212 

REALM 

VARIABLE 

001216 

REALM 

VARIABLE 

001222 

INTEGERS 

VARIABLE 

00  1224 

1HTEGER*2 

VARIABLE 

VECTORED 

VECTORED 


1 
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C 

0136  400  CONTINUE 

D  UR  I TE ( LP , 3 SO ) I HEAD, ( HDR 1 (  I ) , I  =  1 , N 1 ) , ( HDR2 ( I ) , I  =  1 , N2 ) 

3137  IFCN1+N2.GT- 10)  GOTO  423 

0139  UR  I TE ( LP . 4 1 0 ) NR , N I D ,  XCH 1 ,  ICHFL 1 , XCM2,  ICHFL2. 

1  (XI ( I ) , J 1FLAG (I ) , I = 1 , N 1 ) . CX2 ( I) , J2FLPG (I).I=1.N2) 

3140  413  FORMAT ( 15 . 14, IX, 2 (F5 . 2, A 1 ) . !0< IPG  10 . 3, A 1 ) ) 

0141  UR  I TE (3, 412)  NR, HID, ( XN 1(1), I  =  1 ,  N 1 .) , (XN2(I), I  =  1,N2) 

3142  412  FORMAT ( IX, 215, !X, (10 (IPG  11.3))) 

D  UR  I TE (3, 414)  (A1X(I), 1  =  1, Nl), (A2X(I), 1  =  1, N2) 

D  WRITE (3, 414)  (VARl (I), 1=1, Nl), (VAR2( I) , I =1 ,N2) 

D414  FORMAT ( 12X, 10 ( 1PG1 1.3)) 

3143  GOTO  500 
C 

0144  429  UR  I TE ( LP , 440 ) NR , N I D , XCH 1 . 1 CHFL 1 , XCH2 , I CHFL2 , 

1  (XI (I ) , J1FLAG ( I ) , I = 1 , N 1 ) , ( X2 (I ) , J2FLAG ( I) , 1=1 ,N2) 

0145  440  FORMAT (15, 14, 1X,2CF5.2,A1), 10(1PG10.3,A1)/ 

1  (16X, 10(G10.3,A1))) 

0146  WRITE (3, 442)  NR.NID, (XN1 ( I) , I = 1 ,N1 ) , (XN2( I ) , I = 1 , N2) 

014?  442  FORMAT ( IX, 2 15, IX, 10 ( IPG  1 1 ,3)/(6X, 10(G1 1 .3) ) ) 

D  UR  I TE ( 3 , 444)  (A1X(I),I  =  1,N1), (A2X( I),I«1,N2) 

D  UR ITE (3, 444)  (VAR  1(1), 1  =  1, Nl), (VAR2( I) , I  =  1 ,N2) 

D444  FORMAT ( 12X, 10 ( IPG  1 1 . 3) /(6X. 10(1PG11 .3)) ) 

C 

0143  500  RETURN 

3149  END 
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C 


0100 

200 

U 1 =M-N 1 

0191 

U2=M-N2 

3102 

CHU 1 =0 . 

3103 

DO  218  J  =  1 ,  M 

9104 

213 

CHU 1 =CHU 1+R1 IJ)  k  k2 -  A MAX  1 ( Y 1 C J ) ,  1 . ) 

0  1  35 

CHU  1  =CHU  1/lJ  1 

0  1 0b 

ICMFL1 =  I  BLANK 

9137 

XCH 1 =FXCH C  CHU 1 ,  U 1 ) 

0108 

IFCXCH1  .GT.  THRESH)  ICHFL1=I3TAR 

0110 

CHU2=0 . 

0111 

DO  220  J  =  1 , M 

0112 

220 

CHU2 =CHU2+R2 ( J ) **2/AMAX 1 CY2! J) , 1 . ) 

0113 

CHU2=CHU2/U2 

3114 

ICHFL2= IBLANK 

0115 

XCH2  =FXCH (CHU2, U2) 

0116 

IF  CXCH2 . GT. THRESH)  ICHFL2= ISTAR 

0118 

L 

300 

IF (K . GT. 1 )  GOTO  430 

0120 

CALL  AT I ME! KDATE) 

0121 

WRITE  CLP, 305)  CHEADER  Cl), I  =  1.7). KDATE 

0122 

305 

FORMAT! 1H1,2X,7A2,3X, 'PROCESSED  ON  ',12A2) 

0123 

UR  ITE (LP,  3 10)  MS, MF.M, THRESH,  IQ  1 ..  IQ2 

0124 

310 

FORMAT! 1H0, 'OUTPUT  FOR  KALMAN  FILTER'/ 

1  IX, 'USING  DATA  FROM  CHANNEL' . 14. '  TO’, 

2  IX, 'CONDENSED  TO' . 13. ’  OUTPUT  VECTOR  CHANNELS'/ 

3  IX, 'THRESHOLD  IS'.G13.3/ 

4  IX. 'FINAL  LEARNING  RECORDS, ',  15, '  FOR  POD  1,', 

5  15,'  FOR  POD  2') 

0125  NU1-M-N1 

0126  NU2=M-N2 

0127’  WRITE  CLP,  320)  Il.Nl.NUl 

0123  UR  I TE ( LP , 320 )  1 2 , N2 , NU2 

3129  329  FORMAT! IX, 'INPUT  VECTOR  FOR  POD',  11.'  HAS', 13, 

1  '  VARIABLE  INTENSITIES,  LEAVING' , 13. '  DEGREES  OF  FREEDOM') 

9130  I, JR  I  TE  CLP.  360)  IHEAD,  CHDR1CI),  I  =  1 .  N 1  > , 

1  CHDR2C I) . 1=1, N2) 

0131  363  FORMAT! ' 0REC .  MODE' , 1X.6A2.9CA8.3X) ,A8/ 

1  ! 17X, 10CA8.3X) ) ) 

0132  UR  I TEC 3, 370)  (HEADER! I ) , 1*1,7), KDATE 

0133  370  FORMAT! IX, 7A2. 2X, 12A2) 

0134  WRITE <3. 380)  (HDR 1(1), I = 1 ,N 1 ) , (HDR2! I) , I = 1 ,N2) 

0135  330  FORMAT ( '0  REC.  MODE ' , 3X, 3 ( A8 , 3X) , A3/ 

1  C7X, 10CA8.3X) ) ) 
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0069 
003  1 
0973 
8074 
0075 
0076 
0977 
0078 
0079 
0081 
0G32 
0084 
0086 
0033 
0039 
0098 
0091 
8093 
8095 
0097 
0099 


IF(K.GT.l)  NM2=MNM 
IF C1R.GT.  IQ2)  Nt  12  =  1 
DO  140  1  =  1..  M2 

A2X<  I  >  =  <A2X(  I )  *ALX+X2  ( I ) )  /AMX 
A2SQ I )  =  casSQ  <  I )  -:<ALX+X2  ( I )  **2)  /AMX 
A23  <  I }  =  i  A23  ( I )  *AL3+X2  (I ) )  /A  M3 
A25 (1)  =  ( A25 ( I ) -KAL5+X2 (I)) -'fit  15 
VAR2 ( I ) =A23Q ( I ; -A2X( 1 1 **2 
IF  <!< .  EQ .  1 )  VAR2  C I )  =0.2  r.  I )  *X2  < 1 1 **2 
SIG=SQRT(VAR2( I) ) 

IF (NM2.EQ.0)  SIG2(I)=SIG 
IF (NM2.EQ.3)  XII M2 ( I )  =A2X ( I ; 

IFCSIG2C  I)  .GT.  1  .E-20)  XN2C  I)  =  0<2<  D-XNM2U)  )/SIG2(  I) 
3 IG3=S IG/SGR3 
S IG5=S IG/SQR5 
J2FLAG ( I ) = IBLANK 

I F ( XN2 (I ) . GT . THS IG)  J2FL AG  < I)  =  I STAR 
IF (X2( D-A2XC I) . GT.THSIG*SIG)  J2FLAG< I) =ISTAR 
IF (A23( I)-A2XC I) . GT. THS IG*S IG3)  J2FLAG ( Ii = ISTAR 
IF (A25(  I ) -A2X(  I )  . GT.THSIG*SIG5)  J2FLAG C I)  =  ISTAR 
140  CONTINUE 
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0026 

0O27 

0028 

8029 

0038 

0031 

0932 

0033 

3034 

0036 

0038 

0040 

0042 

0043 

0044 

0045 

0046 

0047 

0043 

0050 

0051 

0053 

0055 

0057 

0053 

0059 

0060 

0G62 

0064 

0066 

0063 


C 

! 00  ALX= . 95*AMX 
AMX=ALX+1 . 

AL3= .  b66667-i'-AM3 
AM3=AL3+! . 

AL5=.8*AM5 
AM5=AL5-:-l . 

SGR3=SQRT(3.) 

SQR5=SQRT (5.1 

IF  (H  ID.  EQ.  2.  OR.  N  ID.  EG!.  3.1  MNM=  1 
IF CNID.GT. 10.AND.NID.LT. 100;  MNM= 1 
IF(K.GT.l)  NM1 =MNM 
IFdSR.GT.  IQ1)  NM1  =  1 
DO  120  1=1, N1 

A1XC I)  =(A1X(  I)*ALX+X1<  m/AMX 
A1SQCI) =(A1SQ(I)*ALX+X1  (Dw2)/At1X 
A13(  I)=(A13(  I)*AL3+X1  ( I ) ) /A M3 
A15(  I) =(A15( I)*AL5+X1 ( I) )/AM5 
VAR1 (I) =A1SQ(I)-A1X( I)**2 
IF  CK  .EQ .  1)  VAR  1  ( I)  =Q1  ( I) *X1  ( I **2 
S IG=SQRT (VAR1 ( I) ) 

IF (NM1 .EQ.0)  SIG1 ( I) =SIG 
IFCNM1.EQ.0)  XNM1 (I)=A1X(I) 

IF(SIGKI)  .GT.  l.E-20)  XN 1  ( I)  =  (XI  (  I )  -XNM1  (I ) )  /S IG 1  ( I) 
S IG3=S IG/SQR3 
S IG5=S IG/SQR5 
J 1FLAG ( I) = I BLANK 

IFCXNKD  .GT.THSIG)  J 1FLAG ( I)  =  ISTAR 
IF(X1CI)-A1XCI).GT.THSIG*SIG)  J1FLAGC I) =ISTAR 
IF  (A  13  (  D  -A  1X(  I )  .  GT. TH3 IG*S IG3)  J 1 FLAG (I )= ISTAR 
IF(A15(D-A1XCI)  .GT.THSIG*SIG5)  J 1FLAG ( I)  =  ISTAR 
120  CONTINUE 
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0001 


C 

C 

C 

9002 

0003 

0004 

0005 

0006 

000? 

9008 

0909 

3010 

0011 

0012 

0013 

0014 

0015 

0016 

001? 

0018 

0019 

0020 

0021 

0022 

C 

0023 

0024 

0025 

C 

D 

D20 

D 

D40 

D 

D60 

D 

D 

D 


SUBROUTINE  KCUT(K,NR.NID.X1,X2.P1.F2.Y1.Y2,S1.S2, 
1  Q1,Q2,RI,R2,N1.N2.M,MS,MF) 

OUTPUT  PROGRAM  FOR  THE  KALMAN  FILTER 
LAST  MODIFIED  BY  G .  LI.  PH  ILL  IPS,  JANUARY  1985 


COMMON/HEAD/HDR 1 (3) ,HDR2(3) 

COMMON/HDR/HEADER  ( 10) 

COMMON/ IQ/ IQ  1, IQ2 
INTEGER  HEADER, KDATEC12) 

REALMS  HDR 1 , HDR2 

REAL*4  X1(3),X2(3),P1(3),P2(3),Q1(3).Q2(8) 

REAL*4  Y1 ( 16) ,Y2( 16) ,R1 (16) ,R2( 16) ,S1 ( 16.3) .32 ( 16,3) 
REAL *4  A1X(3),A1SQ(3),A13(3),A15(3) 

RE AL*4  A2X ( 3 ) , A2SQ  ( 3 ) , A23 ( 3 ) , A25  <  3 ) , XNM 1 ( 3 ) , XNM2 ( 8 ) 
REAL*4  VAR  1(8), VAR2 (3) . XN 1 (3) . XH2 (3).S3G1(3),SIG2(3) 
INTEGER  J1FLAGC8) , J2FLAG(3) , IHEADC6) 

DATA  A 1  X/3*0 .  /,  A 1  SQ/3*0  .  /,  A 1 3/8 *0 .  /,  A 1 5/3*0 .  / 

DATA  A2X/3*0 . /, A2SQ/3*0 . /, A23/3*0 . /, A25/3*0 . / 

DATA  XN 1 /3*0 . /, XN 2/8*0 . /, S IG 1 /8*0 . /, S IG2/8*0 . / 

DATA  XNM 1/3*0 . /, XNM2/3*0 . / 

DATA  A MX/0 . /, AM3/0 . /, AM5/0 . /, MNM/Q/ 

DATA  THRESH/3. 0/.THSIG/2.0/, 1 1/1/, 12/2/ 

DATA  LP/6/, IBLANK/1H  /. ISTAR/1H*/ 

REAL*8  AHEAD (2) 

DATA  AHEAD/3HXSQ1  XS.3HQ2  / 

EQUIVALENCE  ( IHEAD, AHEAD) 


CBRTCU)«U**. 3333333 
TLJ9  ( U )  =2 .  /  ( 9 .  *U ) 

FXCH  ( CHU ,  U )  =  ( CBRT  ( CHU )  -  ( 1 . -TLJ9  ( U ) ) ) /SORT  ( TLJ9  ( U ) ) 

OR  ITE  (LP,  20)  II.  (YHI),  I-l.M) 

FORMAT ( 1H0, "POD' ,  12,":  OBSERVED  VECTOR*' ,3G13.3/(6X3G13. 3) ) 
OR ITE(LP, 40)  (Rl(I), 1=1, M) 

FORMAT ( IX. 'RESIDUALS*'. 3G13.3/(6X,3G13. 3) ) 

ORITECL P.60)  (Xl(I).PKI)  .  I  =  1.N1) 

FORMAT ( IX, 'X, P=* . 4(G 13 . 3, ' , ' , G9 . 3) /(6X.4(G 13. 3, ' , ' , G9 .3) ) ) 

OR ITECLP.20) 12, (Y2CI), I-l.M) 

URITE(LP,40)  (R2( I) . 1*1. M) 

ORITE(LP,60)  (X2( I) ,P2( I) . 1*1, N2) 
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OFFSET 

ATTRIBUTES 

v 

0O'3O  1  6 

PEAL  -4 

PARAMETER 

ARRAY 

(3) 

Y 

000320 

REALM 

PARAMETER 

ARRAY 

( 16) 

S 

C00Q22 

REAL M 

PARAMETER 

APR  AY 

< 16,3) 

o 

030024 

REAL  M 

PARAMETER 

ARRAY 

(3) 

p 

03QOS0 

REAL  M 

PAR  AilE  TER 

ARRAY 

(  15) 

30 

00002b 

REAL  M 

PARAMETER 

ARRAY 

(3) 

A  I 

000340 

REALM 

ARRAY  (31 

00G100 

REALM 

ARRAY  (8; 

K 

003014 

INTEGER  *2 

PARAMETER 

VARIABLE 

N 

0G0G32 

INTEGERS 

PARAMETER 

VARIABLE 

M 

000034 

INTEGERS 

PARAMETER 

VARIABLE 

NR 

000036 

INTEGERS 

PARAMETER 

VAR  I  ABLE 

IA 

003140 

INTEGERS 

VARIABLE 

ICRT 

000142 

INTEGER *2 

VARIABLE 

A 

000144 

REALM 

VARIABLE 

B 

000150 

REALM 

VARIABLE 

I 

000232 

INTEGERS 

VARIABLE 

AMAX1 

000000 

REALM 

PROCEDURE 

EPS 

000234 

REALM 

VARIABLE 

J 

000240 

INTEGERS 

VARIABLE 

MOD 

000000 

INTEGERS 

PROCEDURE 

COMMON  BLOCK  /IQ/  LENGTH  060004 


IQ  1  00O000  INTEGERS  VARIABLE 

IQ2  000002  INTEGERS  VARIABLE 


> 
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—  - — , 

0001 

C 

SUBROUTINE  KSTEP(K,X,Y,S,Q,QO,R,N.M,NR) 

SETS  UP  NOISE  VARIANCES  FOR  NEXT  STEP  IN  KALMAN  FILTER 

c 

LAST  MODIFIED  BY  G.U. PHILLIPS,  APRIL  1982 

J 

1 

0002 

REAL *4  X(9) ,  Y( 163 , S C 15,8) ,Q(3),R( 16),Q0(8) 

► 

0003 

REAL *4  A I  (8)  J.A2C8) 

00O4 

DATA  A  1/8*0 .  /,  A2/'3*0 .  / 

0OG5 

DATA  I (VO /, ICRT/5/ 

. -y-v 

0CO6 

DATA  A/0.2/.B/0.8/ 

000? 

C0MM0M/IQ/TQ1, IQ2 

a 

0008 

c 

100 

DO  120  1  =  1,  H 

» 

0009 

Q(  I)  =X(I)**2*Q0(I) 

0010 

Qf I) =AMAX1 (Q( I) ,EPS) 

0011 

120 

CONTINUE 

0G12 

DO  140  J  = 1 , M 

0013 

140 

R(J)=AMAX1(Y(J).  1.) 

C 

C 

CALCULATE  RUNNING  AVERAGES  OF  Q(I) 

» 

C 

FOR  EACH  OF  TUO  PODS 

C 

0014 

200 

IA= IA+1 

0015 

IF (MOD( I A, 2) . EQ.0)  GOTO  250 

0017 

IFCNR.GT. IQ1)  GOTO  230 

• 

0019 

DO  220  1=1, N 

—  : 

1 

0020 

220 

AVI)  =A*Q  (  I )  +B*A  1(1) 

t  ■ 

0021 

230 

DO  240  I  =  1 , N 

*  •  -  .* 

0022 

240 

Q  ( I )  = AMAX 1(Q(I),A1(I)) 

, y. 

D 

GOTO  230 

* 

0323 

RETURN 

•\VV 

a 

0024 

C 

250 

IFCNR.GT. IQ2)  GOTO  270 

»  . 

0O26 

DO  260  1=1, N 

3027 

260 

A2 ( I ) *A*Q ( 1 ) +B*A2 ( I ) 

-**  .  •  . 

0023 

270 

DO  275  I  =  1 ,  N 

3029 

275 

Q  ( I ) = AMAX 1(Q(I),A2(I)) 

D 

GOTO  232 

1  '"'“J 

M 

0030 

C 

RETURN 

r 

0031 

280 

(JR ITE(  ICRT, 284)  IA,  (A1  (I) ,  1  =  1, N) 

■  .  • 

r  *• 

0032 

GOTO  290 

0033 

282 

UR ITE (ICRT, 284)  IA, (A2( I) , 1=1, N) 

0034 

284 

C 

FORMAT (15, 8(1 PG 10. 3)) 

0035 

290 

UR ITE ( ICRT, 292)  (Q(I),I=1.N) 

0036 

292 

FORMAT (5X, 8 ( IPG  10 . 3) ) 

0037 

RETURN 

0038 

END 

• 

1 

• 

r 

1 

■V 

68 

• 

f 

r.  ■ 

•  '  *  *  -  =  .  v *  \-  \ 

1 

»  • 

r. 

-1 

/  ‘'  -'  j 
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0901 

C 

C 

C 

3982 

r 

0083 

0004 

0305 

0006 

0887 

0008 

0009 

0011 

0013 

0015 

0016  100 

0017  200 

0013 

0019 

0020 


SUBROUTINE  LI8IN(LUF,M) 

READS  DATA  FROM  NB  SPECTRAL  DATA  FILES 
WRITTEN  BY  G. PH  ILL  IPS,  JUlY  1981 

COMMON/  ARRAY/ARRAY  (512) 

DEFINE  FILE  LUF (0, 2, U, I VAR) 

I VAR  =193 
DO  100  K  =  2 , M 

READ'.  LUF'  I  VAR,  END  =280)  MSB,  LSB 

RE  1 =MSB 

RE2=LSB 

IF (RE2 . LT. 8 , ) RE2 =65536 . +RE2 
IF (RE  1 . LT. 0 . ) RE  1 =32763 . +RE 1 
IF (RE! .GE. 16384. ) RE 1=RE 1-16334. 
ARRAY(K)  =RE 1*65536. +RE2 
CONTINUE 
M=K- 1 

END  FILE  LUF 

RETURN 

END 


MIDAS 

FORTRAN  IV 

STORAGE 

MAP 

NAME 

OFFSET 

ATTRIBUTES 

LUF 

000014 

INTEGERS 

PARAMETER 

VARIABLE 

M 

030016 

INTEGERS 

PARAMETER 

VARIABLE 

I  VAR 

800024 

INTEGERS 

VARIABLE 

K 

000026 

INTEGERS 

VARIABLE 

MSB 

000030 

INTEGERS 

VARIABLE 

LSB 

000032 

INTEGERS 

VARIABLE 

RE  1 

000034 

REAL*4 

VARIABLE 

RE2 

000040 

REAL*4 

VARIABLE 

COMMON  BLOCK  /ARRAY/  LENGTH  004S00 


ARRAY  000000  REAL*4  ARRAY  (512) 


N 

001406 

INTEGERS  VARIABLE 

» 

riPixo 

000000 

INTEGERS  PROCEDURE 

COMMON 

BLOCK  -'ARRAY-'- 

LENGTH  004000 

ARRAY 

OGOOOO 

REAL  i=4 

ARRAY  (512) 

i 

COMMON 

BLOCK  /HE 

AD/ 

LENGTH  869230 

HDR 1 

000800 

PEAL *8 

ARRAY  (8) 

HDR2 

O0OI00 

REAL-1‘8 

ARRAY  (8) 

COMMON 

BLOCK  /DATA/ 

LENGTH  000240 

i 

DATA 

000000 

INTEGERS  ARRAY  (801 

COMMON 

BLOCK  /FREE/ 

LENGTH  000340 

INTEG 

000000 

INTEGERS  ARRAY  (16) 

REALX 

000040 

REAL*4 

ARRAY  (16) 

i 

ALPHA 

000140 

REAL*3 

ARRAY  (16) 

I 


» 


» 


» 


» 
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NAME 

OFFSET 

ATTRIBUTES 

XI 

000914 

REALM 

PARAMETER 

ARRAY 

(3) 

;<2 

0000  IS 

REAL  M 

PARAMETER 

ARRAY 

13) 

Y ! 

000020 

REALM 

RARArtE  i  ER 

ARRAY 

1 16) 

v 

000022 

PE. ,  _  M 

PARAMETER 

ARRAY 

( 16; 

3  i 

060042 

REAu  M 

PARPMETFR 

ARRAY 

( 16,3 

c-. 

000444 

REAL *4 

PARAMETER 

ARRAY 

( 16,3 

pi 

009032 

REALM 

PARAMETER 

ARRAY 

(3) 

P2 

0OO034 

REALM 

PARAMETER 

ARRAY 

(8) 

Q  1 

C  Q  0  iJ  3  6 

REALM 

PARAMETER 

ARRAY 

(8) 

Q2 

060040 

REALM 

PARAMETER 

ARRAY 

(3) 

H 

600024 

REALM 

PARAMETER 

ARRAY 

(8) 

VI 

060626 

REALM 

PARAMETER 

ARRAY 

(3,8) 

009630 

REALM 

PARAMETER 

ARRAY 

(3,3) 

FILDEF 

00O060 

REAL*B 

ARRAY  (5) 

N 1 

000046 

INTEGERS 

PARAMETER 

VARIABLE 

N2 

060050 

INTEGER *2 

PARAMETER 

VAR  I A 

BLE 

M 

00O032 

INTEGERS 

PARAMETER 

VAR  I ABLE 

MS 

000354 

INTEGERS 

PARAMETER 

VAR  IAi 

BLE 

MF 

600056 

INTEGERS 

PARAMETER 

VARIABLE 

CRT 

000140 

INTEGERS 

VARIABLE 

PERIOD 

000150 

INTEGERS 

VARIABLE 

BLANK 

009152 

INTEGERS 

VARIABLE 

COMMA 

600154 

INTEGERS 

VAR  I  ABLE 

ABLANK 

000130 

REAL 48 

VARIABLE 

LP 

060142 

INTEGERS 

VARIABLE 

IN 

000244 

INTEGERS 

VARIABLE 

IOUT 

000146 

INTEGERS 

VARIABLE 

UJF 

0G0156 

INTEGERS 

VARIABLE 

LEM 

001322 

INTEGERS 

VARIABLE 

I 

091324 

INTEGERS 

VARIABLE 

n;-; 

00 1 326 

INTEGER *2 

VARIABLE 

‘■;v 

GO  1330 

INTEGERS 

VARIABLE 

NA 

801332 

INTEGERS 

VARIABLE 

FREEFM 

0006100 

REALM 

PROCEDURE 

MCL  I 

000000 

INTEGERS 

PROCEDURE 

FK 

00 1334 

REALM 

VARIABLE 

MI 

001340 

INTEGERS 

VARIABLE 

LIB  IN 

000000 

INTEGERS 

PROCEDURE 

ML 

001342 

INTEGERS 

VARIABLE 

IJ 

001344 

INTEGERS 

VARIABLE 

J 

001346 

INTEGERS 

VARIABLE 

MJ 

00 1350 

INTEGERS 

VARIABLE 

SUM 

601352 

REALM 

VARIABLE 

SUMY  1 

001356 

REALM 

VARIABLE 

SUMY2 

801362 

REALM 

VARIABLE 

SUMXt 

801366 

REALM 

VARIABLE 

XNORM1 

0G  1  o  t  2 

REAL  M 

VAR IAELE 

SUMX2 

001376 

REALM 

VARIABLE 

XU0RM2 

00  i  4612 

REAL  M 

VARIABLE 

VECTORED 

VECTORED 


VECTORED 

VECTORED 
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MC LI  (MIDAS  Command  Line  Interpreter)  Subroutine 

The  MCLI  subroutine  linked  to  FORTRAN  allows  the  user  to  perform  MIDAS 
control  console  statements  from  a  FORTRAN  program.  This  routine  is  written 
in  assembler. 

Form 


CALL  MCLI  (<string>[<var>]) 

where: 

<string>  ASCII  string  to  be  executed;  the  string  must  have  the  same 

leading  and  terminating  character;  e.g.  ,  CALL  MCLI  ('@LUP@'). 

<var>  Optional  integer  variable  to  receive  the  error  code.  If  no 

<var>  is  specified  and  an  error  occurs,  then  a  direct  return 
to  MIDAS  is  taken. 

Codes  returned  in  <var>  are  as  follows: 

1  if  no  errors  normal  condition. 

2  if  CLI$  has  returned  an  error. 

3  if  MIDAS  command  name  is  invalid. 

Notes 


The  user  should  note  that  if  MCLI  is  called  with  <1  or  >2  arguments,  then  an 
immediate  return  is  made  to  MIDAS. 

The  following  MIDAS  commands  are  forbidden  in  the  MCLI  subroutine:  ABORT, 
BYE,  CHAIN,  DUPLICATE,  ENDJOB,  GOTO,  HELLO,  INIT,  MESSAGE,  PATCH,  PAUSE, 
PROMPT,  and  REORDER. 

The  RUN  command  will  cause  the  terminal  to  cease  operating  if  either  the 
calli-g  program  or  the  invoking  program  does  an  input  from  the  terminal.  The 
terminal  will  cease  operating  after  both  programs  exit.  This  may  require 
using  CONTROL  P  to  restore  the  terminal. 


194L/A 
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MTAPEF  (FORMATTED  MAGNETIC  TAPE)  SUBROUTINE 

The  MTAPEF  subroutine  controls  the  magnetic  tape  and  its  related  functions. 
The  subroutine  is  compatible  with  either  7  or  9  track  magnetic  tape.  This 
suDroutine  is  written  in  Assembler. 

Form 


CALL  MTAPEF  (a,b,c,d,e) 
where: 

a  =  Command:  INTEGERS  variable  (required  argument). 
=  1  -  Initialize  control  formatter  (a,b). 

=  2  -  Transport  off-line  (a,b). 

=  3  -  Rewind  (a,b). 

=  4  -  Search  for  logical  EOT  (a,b). 

=  5  -  Search  for  file  (a,b,c). 

=  6  -  Search  for  record  (a,b,c). 

=  7  -  Read  one  record  (a.b.c.d.e). 

=  8  -  Verify  one  record  (a,b,c,d,e). 

=  9  -  Write  one  record  (a,b,c,d). 

=  10  -  Not  used. 

=  11  -  Over  write  one  record  (a,b,c,d). 

=  12  -  Dump  one  record  (a,b,c,d). 

=  13  -  Write  one  filemark  (a,b). 

=  14  -  Write  a  logical  EOT  (a,b). 

=  15  -  Open  transport  (a,b,c). 

=  16  -  Close  transport  (a,b). 

=  17  -  Tagword  (a,b,c,d) 

b  =  Error  Number:  INTEGER*2  variable  (required). 

=  1  -  No  error. 

=  2  -  Transport  assigned  to  other/or  no  user. 

=  3  -  Magnetic  tape  transport  number  error. 

=  4  -  Segment  is  read  only. 

=  5  -  Segment  is  not  accessible  for  I/O. 

=  6  -  Memory  is  not  contiguous. 

=  7  -  Cross  segments  have  different  status. 

=  8  -  No  filemark  detected  for  last  operation. 

=  9  -  Filemark  detected  during  last  operation. 

=  10  -  Located  on  or  past  physical  EOT. 

=  11  -  Record  read  less  than  list  word  #14. 

=  12  -  Record  read  greater  than  list  word  #14. 

=  13  -  Invalid  or  undefined  OP  code. 

=  14  -  Data  late. 

=  15  -  Invalid  password. 

=  16  -  Motion  error. 

=  17  -  Verification  error. 

=  18  -  Write  protect  error. 

=  19  -  Parity  CRC  or  LRC  error  during  read. 

=  20  -  Operation  attempt  on  off-line  transport. 

=  21  -  No  logical  EOT  detected  during  operation. 
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=  22  -  Logical  EOT  detected  during  operation. 

=  23  -  Magnetic  tape  not  off-line. 

=  24  -  Undefined  error  bit  in  status. 

=  25  -  Executive  error  during  operation. 

=  26  -  Illegal  number  of  arguments. 

=  27  -  Illegal  command  number. 

=  28  -  Record  length  greater  than  513  bytes  for  7  track  transport 
c  =  Command  Parameter  1:  INTEGER*2  variable. 


Command  Number  Parameter 


5 

6 

7 

8 
9 

11 

12 

15 

17 


#  files  to  skip 

#  records  to  skip 

#  bytes  to  skip 

#  bytes  to  skip 

#  bytes  to  write 

#  bytes  to  write 

#  bytes  to  write 

#  transport  to  open 
Subcommand  code  (c) 
c  =  1  -  Get  tagword 

c  =  2  -  Increment  tagword 
c  =  3  -  Put  tagword 


d  =  Command  Parameter  2:  INTEGERS  variable  or  array  name. 


Command  Number  Parameter 


7  #  bytes  to  read 

8  #  bytes  to  verify 

9  Array  name  to  write 

11  Array  name  to  write 

12  Array  name  to  write 

17  Get,  Increment,  or  Put  tagword 

e  =  Command  parameter  3:  Integer  variable. 

Command  Number  Parameter 


7 

8 


Array  name  to  read 
Array  name  to  veri fy 


OANDC  (Open  and  Close)  Subroutine 

The  OANDC  subroutine  allows  the  user  to  open  a  file  and  get  the  parameters  in 
the  device  control  block  (DCB)  table.  If  the  input  parameter  EMFLAG  is  set 
to  zero,  the  file  is  opened.  The  end  sector  is  moved  to  its  maximum  extent. 
If  the  file  is  empty,  a  flag  is  returned  to  the  user  as  EMFLAG=1  to  indicate 
file  was  empty.  OANDC  then  closes  the  file  so  that  the  FORTRAN  program  can 
open  it.  If  a  FORTRAN  program  uses  OANDC,  the  program  must  call  OANDC  before 
the  first  read/write  to  the  logical  unit  in  the  FORTRAN  program.  This 
subroutine  is  written  in  assembler. 

Form 

CALL  OANOC  ( 1 un i t, error, dvcode, absec t, v 1  sect, dataty, resize, by 1  as t,emf lag) 
where: 

All  the  parameters  are  integers  and  have  the  following  values: 

lunit  Logical  unit  number  (1-12)  of  the  file  (input  parameter). 

error  Error  flag.  Contains  system  error  number  if  error  occurred; 

otherwise  set  to  zero.  A  negative  error  number  means  open  error;  a 
positive  error  number  means  close  error. 

dvcode  Device  code  (output  parameter). 

=  0  -  Teletype. 

=  2  -  Dummy  device. 

=  3  -  Line  printer. 

=  4  -  High  speed  paper  tape  punch. 

=  5  -  High  speed  paper  tape  reader. 

=  6  -  Disk  file. 

absect  Absolute  number  of  sectors  in  the  file  (output  parameter), 

vlsect  Valid  number  of  sectors  in  the  file  (output  parameter), 

dataty  Data  type  (0-255)  (output  parameter), 
resize  Record  size  (0-255)  (output  parameter). 

by last  Number  of  bytes  in  the  last  sector  (1-256)  (output  parameter). 

emflag  Empty  flag  (input  and  output  parameter). 

Input  -  If  zero,  a  file  will  have  its  end  sector  moved  out  to  the 
absolute  end  sector  minus  one  and  bytes  in  the  last  sector 
set  to  256. 

Output  -  Set  to  one  if  file  was  empty. 


vpenaix  D:  IMSL*  Subroutines 


1.  ( r  T KAL>'I  J 

2.  LtqTlf 

3.  LUDATF 

4.  LUELMf 

5.  UERTST 
o.  VMULFF 
7.  VMULFP 
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SUBROUTINE 
BASED  OH  IMS! 


COMPUTER 
LATEST  REV IS 
PURPOSE 
USAGE 

ARGUMENTS 


DPKALM 

ROUTINE  NAME  -  FTKALM 


-  HD  SS20 

ON  -  JULY  1931  BY  G.U.P. 

-  KALMAN  FILTERING 

-  CALL  DDKALM(K,X,H,Y,S,Q,R,P, IN, IS, IL.N.Ml.L. 

T1.T2, IT, T3, IER) 

K  -  INPUT  STEP  COUNTER.  K=0, 1,2 _ 

WHEN  K  IS  EQUAL  TO  ZERO,  VECTOR  X  SHOULD 
CONTAIN  THE  PRIOR  ESTIMATE  OF  THE  MEAN  OF  X, 
AND  THE  PROGRAM  CALCULATES  THE  ESTIMATED 
VARIANCE  OF  X  AS  P=GQG-TRANSPOSE  AT  STEP  0. 

X  -  INPUVOUTPUT  VECTOR  OF  LENGTH  N.  ON  INPUT, 

X  IS  THE  STATE  VECTOR  AT  STEP  K,  AND  ON 
OUTPUT.  X  CONTAINS  THE  ESTIMATED  STATE 
VECTOR  AT  STEP  K+l. 

H  -  INPUT  VECTOR  OF  DIMENSION  N.  H  IS  THE 

TRANSITION  VECTOR  AT  STEP  K. 

Y  -  INPUT  OBSERVATION  VECTOR  OF  LENGTH  Ml  AT 

STEP  K+l. 

S  -  INPUT  MATRIX  OF  DIMENSION  Ml  BY  N  AT  STEP  K+l. 

Q  -  INPUT  VARIANCE  VECTOR  OF  DIMENSION  L 

AT  STEP  K. 

R  -  INPUT  VARIANCE  VECTOR  OF  DIMENSION 

Ml  AT  STEP  K+l. 

P  -  INPUT/OUTPUT  MATRIX  OF  DIMENSION  N  BY  N. 

ON  INPUT.  P  IS  THE  VARIANCE  MATRIX  OF  X 
AT  STEP  K.  ON  OUTPUT,  P  IS  THE  ESTIMATED 
VARIANCE  MATRIX  OF  X  AT  STEP  K+l. 

IN  -  INPUT  ROU  DIMENSION  OF  THE  MATRICES  H, G,  AND  P 
EXACTLY  AS  SPECIFIED  IN  THE  DIMENSION  STATE¬ 
MENT  IN  THE  CALLING  PROGRAM. 

IS  -  INPUT  ROU  DIMENSION  OF  THE  MATRICES  S  AND  R 

EXACTLY  AS  SPECIFIED  IN  THE  DIMENSION  STATE¬ 
MENT  IN  THE  CALLING  PROGRAM. 

IL  -  INPUT  ROU  DIMENSION  OF  THE  MATRIX  Q  EXACTLY 
AS  SPECIFIED  IN  THE  DIMENSION  STATEMENT  IN 
THE  CALLING  PROGRAM. 
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MUST  EQUAL  N 
Ti 


INPUT  SCALAR .  SEE  DESCRIPTIONS  OF  X.H.G,M,P. 

N  MUST  BE  GREATER  THAN  0. 

INPUT  SCALAR.  SEE  DESCRIPTIONS  OF  Y,S,R,T3. 

Ml  MUST  BE  GREATER  THAN  0. 

INPUT  SCALAR.  SEE  DESCRIPTIONS  OF  G.Q. 

L  MUST  BE  GREATER  THAN  0. 

WORK  MATRIX  OF  DIMENSION  NM  3Y  NM,  WHERE 
NM  IS  7 HE  MAXIMUM  OF  N  AND  Ml. 

WORK  MATRIX  OF  DIMENSION  NM  BY  NML ,  WHERE 
NML  IS  THE  MAXIMUM  OF  NM  AND  L. 

ROW  DIMENSION  OF  THE  MATRICES  Tl  AND  T2 
EXACTLY  AS  SPECIFIED  IN  THE  DIMENSION 
STATEMENT  IN  THE  CALLING  PROGRAM. 

WORK  VECTOR  OF  LENGTH  Ml. 

ERROR  PARAMETER.  (OUTPUT) 

TERMINAL  ERROR 

IER=  129  INDICATES  ONE  OF  IN,  IS,  IL,  OR  IT 
IS  TOO  SMALL,  OR  THAT  ONE  OF  N,  Ml, 

OR  L  IS  NOT  A  POSITIVE  INTEGER. 

IER= 133  INDICATES  AN  ERROR  OCCURRED  IN 
IMSL  ROUTINE  LEQT1F . 


REQD.  IMSL  ROUTINES  -  LEQT IF , LUDATF , LUELMF , UERTST, 
VMULFF , VMULFP , VXADD , VXMUL , VXSTO 
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r 

000  1 

0002 

c 

0003 

0004 

- 

0005 

0006 

0003 

0009 

0010 

D 

c 

801 1 

0013 

0014 

0015 

6 

0016 

0017 

8 

C 

0018 

10 

0019 

15 

C 

0020 

0021 

0022 

20 

0023 

0024 

25 

SUBROUTINE  DDKALM  <K,X.H, Y.S,Q,R,P, IN, IS, IL, N, Ml , L, T1 , T2, IT, 

1  T3.IER) 

SPECIFICATIONS  FOR  ARGUMENTS 
INTEGER  K, IN, IS, IL,N,M1,L, IT, IER 

REALM  XC  1)  ,H(  IN)  ,Y(1)  ,S( IS,  1)  ,QC  IL) , 

1  R ( IS) .PC  IN, 1) ,T1 C IT. 1) .T2C IT, 1) ,T3C 1) 

SPECIFICATIONS  FOR  LOCAL  VARIABLES 

INTEGER  1 , 10, 1 1 , J 

DATA  10/0/, 11/1/ 

FIRST  EXECUTABLE  STATEMENT 
IF  ( IH.GE.N  .AND.  IS.GE.Ml  .AND.  IL.GE.L 

*  .AND.  ( IT.GE.N  .OR.  IT.GE.M1)  .AND.  N.GT.0 

*  .AND.  M1.GT.0  .AND.  L.GT.0)  GO  TO  5 
IER  =  129 

GO  TO  9000 
5  IER  =  0 

CALL  KPRINT(K,X,H,G,Y.S,Q.R,P, IN, IS, IL,N,M1,L) 

CALCULATE  P  IF  K  =  ZERO 

IF  (K  .NE.  0)  GO  TO  10 
DO  6  1=1, N 
DO  6  J=  1 , N 
P(I,J)=0. 

DO  8  I = 1 , N 
PCI,  I)=Q(I) 

CALCULATE  X-PRIME  AT  STEP  K+l 

DO  15  1=1, N 

xcn=xcn*H(i) 

CALCULATE  P-PRIME  AT  STEP  K+l 

DO  20  1=1, N 
DO  20  J  =  1 , N 

PC  I,  J)  =P C I ,  J) *H ( I ) >KH ( J) 

DO  25  I = 1 , N 
P C I ,  I)  =P  C I ,  I )  +Q C I ) 
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3029 

3030 

3031 
3933 
0034 
0035 
0036 
0037 
0033 
0039 

£ 

0040 

3041 

0042 

0043 

0044 

0045 

0046 

0047 

0043 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

0056 

0057 

0058 

0059 


CALCULATE  MATRIX  K  AT  STEP  K+l 

SStSKS  {&  *:S:  WftSftS® 

no  35  1  =  1  *  Ml 
71(1.  i:'=THI,  D-rP-lH 

Ku'mOTIFiTI.  i!.m.  n.T2.I0.T3.!ER> 

IPiIER  .EQ.  0)  GO  TO  40 
I  EE  =  13Q 
GO  TO  9000 
40  DO  50  1  =  1.M1 

DO  45  J  =  l.M  .  „ 

T1 ( J, I)  =  T2 ( 1 , J 1 

45  CONTINUE 

50  CONTINUE  CALCULATE  X-HAT  AT  STEP  K+l 

55  MIL  VMULFF  (  S.  X.M1,  N.  U.  13. I»-T3-  IS-  IER) 

00  ?<!.'- na>  - 

60  CONTINUE  ..  Mt  jy  ic  T2. IT. IEP1 

CALL  VMULFF  (T1.T3.  N.M1.I1.IT, 15. 

DO  65  1  =  l.N  ,, 

X(  I)  •  X( I)  -  T2l 1. 1) 

65  CONTINUE  CALCULATE  P  AT  STEP  K+l 

ss  m.  ?:  K: 

DO  75  I  =  l.N 

DO  70  J  =■  l.N  , ,  ... 

PC  I ,  J1  3  P<  I  .'ll  ~  TIC  I ,  J ) 

?0  CONTINUE 
75  CONTINUE 
GO  TO  9005 

9080  Sl™'ertst  aw.*®**™ 

9005  RETURN 
END 
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NAME 

OFFSET 

AT”  IBUTES 

V 

000016 

REAL*4 

PARAMETER 

ARRAY  (!) 

A 

000820 

REALM 

PARAMETER 

ARRAY  (IN) 

IN 

030334 

INTEGERS 

PARAMETER 

VARIABLE 

Y 

800022 

REALM 

PARAMETER 

ARRAY  (1) 

5 

00082  4 

REAL K4 

PARAMETER 

ARRAY  (IS, 

I) 

IS 

008035 

INTEGER*? 

PARAMETER 

VARIABLE 

Q 

00002b 

REAL -*4 

PARAMETER 

ARRAY  (IL) 

IL 

800043 

INTEGERS 

PARAMETER 

VARIABLE 

R 

000030 

REAL *4 

PARAMETER 

ARRAY  (IS) 

P 

000032 

REALM 

PARAMETER 

ARRAY  (IN, 

1) 

T1 

000050 

REALM 

PARAMETER 

ARRAY  (IT, 

1) 

IT 

000054 

INTEGER*? 

PARAMETER 

VARIABLE 

T2 

000052 

REAL*4 

PARAMETER 

ARRAY  (IT, 

1) 

T3 

000055 

R£AL*4 

PARAMETER 

ARRAY  (I) 

K 

000014 

INTEGER*? 

PARAMETER 

VARIABLE 

N 

300042 

INTEGERS 

PARAMETER 

VARIABLE 

Mi 

800044 

INTEGER*? 

PARAMETER 

VARIABLE 

L 

300046 

INTEGER*? 

PARAMETER 

VARIABLE 

IER 

000060 

INTEGERS 

PARAMETER 

VARIABLE 

I 

000076 

INTEGERS 

VARIABLE 

10 

000062 

INTEGER*? 

VARIABLE 

1 1 

800064 

INTEGERS 

VARIABLE 

J 

000100 

INTEGER*? 

VAR  I ABLE 

VMULFP 

000000 

REAL *4 

PROCEDURE 

LEQTiF 

000000 

INTEGER*2 

PROCEDURE 

VMULFF 

000000 

REAL *4 

PROCEDURE 

UcRTST 

009000 

REAL*4 

PROCEDURE 
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C  IMSL  ROUTINE  NAME  -  LEQT1F 


C 

C 

c 

0 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


-  r(D  6620 

-  MAY  1981  BY  G.U.P. 

-  LINEAR  EQUATION  SOLUTION  -  FULL  STORAGE 
MODE  -  SPACE  ECONOMIZER  SOLUTION. 

-  CALL  LEQT1F  (A.M.N, IA.B, IDGT.UKAREA, IER) 

-  INPUT  MATRIX  OF  DIMENSION  N  BY  N  CONTAINING 
THE  COEFFICIENT  MATRIX  OF  THE  EQUATION 
AX  =  B. 

ON  OUTPUT,  A  IS  REPLACED  BY  THE  LU 

DECOMPOSITION  OF  A  ROUtJISE  PERMUTATION  OF 
A. 

-  NUMBER  OF  RIGHT-HAND  SIDES.  (INPUT) 

-  ORDER  OF  A  AND  NUMBER  OF  ROUS  IN  B.  (INPUT) 

-  ROU  DIMENSION  OF  A  AND  B  EXACTLY  AS  SPECIFIED 
IN  THE  DIMENSION  STATEMENT  OF  THE  CALLING 
PROGRAM.  (INPUT) 

-  INPUT  MATRIX  OF  DIMENSION  N  BY  M  CONTAINING 
RIGHT-HAND  SIDES  OF  THE  EQUATION  AX  =  B. 

ON  OUTPUT,  THE  N  BY  M  SOLUTION  X  REPLACES  B. 

-  INPUT  OPTION. 

IF  IDGT  IS  GREATER  THAN  0,  THE  ELEMENTS  OF 
A  AND  B  ARE  ASSUMED  TO  BE  CORRECT  TO  IDGT 
DECIMAL  DIGITS  AND  THE  ROUTINE  PERFORMS 
AN  ACCURACY  TEST. 

IF  IDGT  EQUALS  ZERO,  THE  ACCURACY  TEST  IS 
3YPASSED . 

UKAREA  -  WORK  AREA  OF  DIMENSION  GREATER  THAN  OR  EQUAL 
TO  N. 

IER  -  ERROR  PARAMETER.  (OUTPUT) 

TERMINAL  ERROR 

IER  =  129  INDICATES  THAT  MATRIX  A  IS 
ALGORITHMICALLY  SINGULAR.  (SEE  THE 
CHAPTER  L  PRELUDE). 

UARNING  ERROR 

IER  =  34  INDICATES  THAT  THE  ACCURACY  TEST 
FAILED.  THE  COMPUTED  SOLUTION  MAY  BE  IN 
ERROR  BY  MORE  THAN  CAN  BE  ACCOUNTED  FOR 
BY  THE  UNCERTAINTY  OF  THE  DATA.  THIS 
UARNING  CAN  BE  PRODUCED  ONLY  IF  IDGT  IS 
GREATER  THAN  0  ON  INPUT.  (SEE  CHAPTER  L 
PRELUDE  FOR  FURTHER  DISCUSSION). 


COMPUTER 
LATEST  REVISION 
FUPDOSE 

USAGE 

ARGUMENTS  A 

M 

N 

IA 

B 

IDGT 
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PfiGE  002 


101 

102 


383 

304 

305 


307 

008 

009 

010 

012 

013 

014 

015 


SUBROUTINE  LEQT1F  (A.M.N, IA,3, I  DOT, UK AREA, IER) 

C 

DIMENSION  ACIh. 1) . B ( IA . 1 ) , WKAREA (1 ) 

C  INITIALISE  IER 

C  FIRST  EXECUTABLE  STATEMENT 

IEF:=0 

C  DECOMPOSE  A 

CALL  LUDATF  CA.A.N, I A, I  DOT. D 1 , D2, UK AREA . UKAPEA , DA . IER) 

IF  C IER  .GT.  123)  GO  TO  9000 

C  CALL  ROUTINE  LUELMF  (FORWARD  AND 

C  BACKWARD  SUBSTITUTIONS) 

DO  10  J  =  1 ,  M 

CALL  LUELMF  (A»B( 1, J) , UK AREA, N, IA,8(  1, J) ) 

10  CONTINUE 

IF  (IER  .EQ.  0)  GO  TO  9005 
9000  CONTINUE 

CALL  UERTST  ( IER, 6HLEQT1F) 

9605  RETURN 
END 


1 1  DAS  FORTRAN  IV  STORAGE  MAP 

IAME  OFFSET  ATTRIBUTES 


1 

000014 

REALM 

:a 

000022 

INTEGERS 

i 

000024 

REALM 

JKAPEA 

300030 

REAL*4 

1 

000016 

INTEGEP*2 

1 

000020 

INTEGER*2 

[DOT 

000026 

INTEGERS 

IER 

006032 

INTEGERS 

JJPATF 

000000 

INTEGERS 

)1 

000044 

RL  ALM 

)2 

060850 

REALM 

JA 

000054 

REALM 

I 

000060 

INTEGERS 

.UELMF 

000000 

INTEGERS 

JERTST 

000000 

REALM 

PARAMETER  ARRAY  (IA,1) 

PARAMETER  VARIABLE 

PARAMETER  ARRAY  CIA.  1 ) 

PARAMETER  ARRAY  (1) 

PARAMETER  VARIABLE 

PARAMETER  VARIAELE 

PARAMETER  VARIABLE 

PARAMETER  VARIABLE 

PROCEDURE 

VARIABLE 

VARIABLE 

VARIABLE 

VARIABLE 

PROCEDURE 

PROCEDURE 
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C  I MSI  POUT I HE  HOME  -  LUDATF 
C 


CCMPUiZR  -  NDS620 

LATEST  REVISION  -  MAY  1981  BY  G.IJ.P 


PURPOSE 


C 

C  USAGE 

C 

C 

C  ARGUMENTS 
C 
C 
c 


c 

c 

r 

C 

C 

C 

c 

c 

c 

c 


c 

c 


-  L-U  DECOMPOSITION  BY  THE  CROUT  ALGORITHM 

WITH  OPTIONAL  ACCURACY  TEST. 

-  CALL  LUDATF  (A,LU,N, I A, IDGT,D1,D2, I PVT, 

EQU  IL.IJA,.  IER) 

A  -  INPUT  MATRIX  OF  DIMENSION  N  BY  N  CONTAINING 

THE  MATRIX  TO  BE  DECOMPOSED. 

LU  -  REAL  OUTPUT  MATRIX  OF  DIMENSION  N  BY  N 
CONTAINING  THE  L-U  DECOMPOSITION  OF  A 
ROUUISE  PERMUTATION  OF  THE  INPUT  MATRIX. 
FOR  A  DESCRIPTION  OF  THE  FORMAT  OF  LU,.  SEE 
EXAMPLE . 

N  -  INPUT  SCALAR  CONTAINING  THE  ORDER  OF  THE 

MATRIX  A. 

I A  -  INPUT  SCALAR  CONTAINING  THE  ROW  DIMENSION  OF 
MATRICES  A  AND  LU  EXACTLY  AS  SPECIFIED  IN 
THE  CALLING  PROGRAM. 

IDGT  -  INPUT  OPTION. 

IF  IDGT  IS  GREATER  THAN  ZERO,  THE  NON-ZERO 
ELEMENTS  OF  A  ARE  ASSUMED  TO  BE  CORRECT  TO 
IDGT  DECIMAL  PLACES.  LUDATF  PERFORMS  AN 
ACCURACY  TEST  TO  DETERMINE  IF  THE  COMPUTED 
DECOMPOSITION  IS  THE  EXACT  DECOMPOSITION 
OF  A  MATRIX  WHICH  DIFFERS  FROM  the  GIVEN 
ONE  BY  LESS  THAN  ITS  UNCERTAINTY. 

IF  IDGT  IS  EQUAL  TO  ZERO,  THE  ACCURACY  TEST 
IS  BYPASSED. 
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i 


C 

c 

c 

L. 

r 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


D 1 


I  PVT 


EQUIL 


WA 

IER 


OUTPUT  SCALAR  CONTAINING  ONE  OF  THE  TWO 
COMPONENTS  OF  THE  DETERMINANT.  SEE 
DESCRIPTION  OF  PARAMETER  D2,  BELOW. 

OUTPUT  SCALAR  CONTAINING  ONE  OF  THE 

TOO  COMPONENTS  OF  THE  DETERMINANT.  THE 
DETERMINANT  MAY  BE  EVALUATED  AS  (D1X2**D2). 

OUTPUT  VECTOR  OF  LENGTH  N  CONTAINING  THE 
PERMUTATION  INDICES.  SEE  DOCUMENT 
(ALGORITHM) . 

OUTPUT  VECTOR  OF  LENGTH  N  CONTAINING 
RECIPROCALS  OF  THE  ABSOLUTE  VALUES  OF 
THE  LARGEST  '.IN  ABSOLUTE  VALUE)  ELEMENT 
IN  EACH  ROU. 

ACCURACY  TEST  PARAMETER.  OUTPUT  ONLY  IF 
IDGT  IS  GREATER  THAN  ZERO. 

SEE  ELEMENT  DOCUMENTATION  FOR  DETAILS. 

ERROR  PARAMETER.  (OUTPUT) 

TERMINAL  ERROR 

IER  =  129  INDICATES  THAT  MATRIX  A  IS 
ALGORITHMICALLY  SINGULAR.  (SEE  THE 
CHAPTER  L  PRELUDE) . 

WARNING  ERROR 

IER  =  34  INDICATES  THAT  THE  ACCURACY  TEST 
FAILED.  THE  COMPUTED  SOLUTION  MAY  BE  IN 
ERROR  BY  MORE  THAN  CAN  BE  ACCOUNTED  FOR 
BY  THE  UNCERTAINTY  OF  THE  DATA.  THIS 
WARNING  CAN  BE  PRODUCED  ONLY  IF  IDGT  IS 
GREATER  THAN  0  ON  INPUT.  SEE  CHAPTER  L 
PRELUDE  FOR  FURTHER  DISCUSSION. 


REGD.  IMSL  ROUTINES  -  UERTST. UGETIO 


REMARKS  A  TEST  FOR  SINGULARITY  IS  MADE  AT  TWO  LEVELS: 

1.  A  ROW  OF  THE  ORIGINAL  MATRIX  A  IS  HULL. 

2.  A  COLUMN  BECOMES  NULL  IN  THE  FACTORIZATION  PROCESS. 
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I 


» 


C 
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■.  ■.  1  i  w 


C 

0001 

c 

SUBROUTINE  LUDATF  CA,ALU,N, IA, !DGT,D1.D2, IPVT,EQUIL,UA, IER) 

0002 

L 

DIMENSION  A  C I A .  1),AUJCIA.  1 ) .  IPVTtl ) ,  EQU IL  ( 1 ) 

• 

— * 

0003 

DATA  ZERO , ONE , FOUR , S I XTN , S I XTH/0 . , 1 . . 4 . , 

•  ■„< 

:K  1S.,.0S25/ 

r 

FIRST  EXECUTABLE  STATEMENT 

.■  v* 

c 

INITIALIZATION 

D 

WRITE (6, 1000) 

•  V- 

D 1000  FORMAT ( 1H0, 'ENTERING  LUDATF,  INPUT  MATRIX') 

-**4 

D 

DO  1020  1=1, N 

• 

D 

WRITE (6, 1310) (AC  I, J) ,  J  =  1 ,  N ) 

■  .  * 

D 10 10  FORMAT ( 1X,3G13.3/(5X,3G13.3) ) 

‘  V 

D1020  CONTINUE 

0004 

IER  =  0 

>■ 

-  , 

0005 

RN  =  N 

0006 

UREL  =  ZERO 

- 

‘ 

000? 

D 1  =  ONE 

• 

0008 

D2  =  ZERO 

0009 

BIGA  =  ZERO 

0010 

DO  10  1=1, N 

-  • 

0011 

BIG  =  ZERO 

0012 

DO  5  J= 1 . N 

0013 

P  =  ACI.J) 

• 

3014 

ALU(I.J)  =  P 

0015 

P  =  ABS(P) 

0016 

IF  (P  , GT.  BIG)  BIG  =  P 

•  ■ 

0013 

5  CONTINUE 

0019 

IF  (BIG  ,GT.  BIGA)  BIGA  =  BIG 

0021 

IF  (BIG  .EQ.  ZERO)  GO  TO  110 

3023 

EQUIL(I)  =  ONE/BIG 

• 

0024 

10  CONTINUE 

.  y 

0025 

DO  105  J=  1 , N 

•*< 

0026 

JM1  =  J-l 

yy. 

X 

002? 

IF  ( JM1  .LT.  1)  GO  TO  40 

+■- 

*“  V' 

*- 

-  4 

« * 

■  _  *  • 

-  * 

• 

• 

* 

• 

< 

93 
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C 

COMPUTE  U(I,J),  I-i . J-l 

0029 

DO  35  I*1,JM1 

0030 

SUM  =  ALU(I.J) 

3031 

IM1  =  1-1 

0032 

IF  UDGT  .E Q.  0)  GO  TO  25 

P 

C 

WITH  ACCURACY  TEST 

•  * 

0934 

A I  =  ABS(SUM) 

“ 

3035 

UI  =  ZERO 

•  ** 

3036 

IF  ( IM1  .LT.  1)  GO  TO  23 

J 

0038 

DO  15  K-1.IM1 

.*-V 

0039 

T  =  ALU(I,K)*ALU(K.J) 

m 

0040 

SUM  3  SUM-T 

w 

0041 

UI  =  UI+ABS(T) 

0042 

15 

CONTINUE 

0043 

ALU ( I , J)  =  SUM 

' 

0044 

20 

UI  -  UI+ABSCSUM) 

0045 

IF  (A I  .EQ.  ZERO)  AI  3  BIGA 

< 

0047 

TEST  =  UI/AI 

• 

0048 

IF  (TEST  .GT.  UREL)  UREL  *  TEST 

0050 

GO  TO  35 

~ 

C 

UITHOUT  ACCURACY 

0051 

25 

IF  ( IM1  .LT.  1)  GO  TO  35 

0053 

DO  30  K3 1 , IM1 

0054 

SUM  3  SUM-ALU(I,K)*ALU<K,J) 

•/ 

0055 

30 

CONTINUE 

• 

0056 

ALU ( 1 ,  J)  *  SUM 

,  • 

0057 

35 

CONTINUE 

0058 

40 

P  »  ZERO 

«rV« 

* 


r 


94 
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C 

COMPUTE  U(J,J)  AND  L( 

0059 

DO  70  I=J,N 

0060 

SUM  =  ALU ( I ,  J) 

0061 

IF  ( I DGT  .EQ.  O)  GO  TO  55 

C 

WITH  ACCURACY  TEST 

9063 

A I  =  ABS(SUM) 

0064 

U!  =  ZERO 

0065 

IF  CJM1  .LT.  1)  GO  TO  50 

3067 

DO  45  K=l, JM1 

0068 

T  =  ALU(I,K)*ALU(K,J) 

0069 

SUM  =  SUM-T 

0070 

UI  =  UI+ABS (T) 

3071 

45 

CONTINUE 

0072 

ALU ( I ,  J)  =  SUM 

0073 

50 

UI  =  UI+ABS (SUM) 

0074 

IF  (AI  .EQ.  ZERO)  AI  =  3IGA 

0076 

TEST  =  UI/AI 

0077 

IF  (TEST  .GT.  UREL)  UREL  =  TEST 

0079 

GO  TO  65 

c 

UITHOUT  ACCURACY  TEST 

0O80 

55 

IF  ( JM1  .LT.  1)  GO  TO  65 

0082 

DO  60  K= 1 , JM1 

0083 

SUM  =  SUM-ALU(I,K)*AUJ(K,J) 

0084 

60 

CONTINUE 

0085 

ALU ( I , J )  =  SUM 

0086 

65 

Q  =  EQU I L ( I ) *ABS ( SUM) 

0087 

IF  (P  .GE.  Q)  GO  TO  70 

0089 

P  =  Q 

0090 

IMAX  =  I 

0091 

70 

CONTINUE 

,J) 
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c 

TEST  FOR  ALGORITHMIC  SINGULARITY 

0092 

IF  (RN+P  .EG.  RN)  GO  TO  110 

0094 

IF  (J  .EQ.  I MAX)  GO  TO  30 

C 

INTERCHANGE  ROUS  J  AND  3 MAX 

0096 

D 1  =  -D1 

0997 

DO  75  K=1,N 

0098 

P  =  ALU <1 MAX, K) 

0099 

ALU ( I MAX, K )  =  ALU(J,K) 

0100 

ALUCJ.K)  =  P 

0101 

75 

CONTINUE 

0102 

EQUIL(IMAX)  =>  EQUIL(J) 

0103 

80 

IPVT(J)  =  IMAX 

0104 

D1  =  D1*ALU(J, J) 

0105 

85 

IF  (ASS(Dl)  .LE.  ONE)  GO  TO  90 

0107 

D1  =  D1*SIXTH 

0108 

D2  =  D2+F0UR 

0109 

GO  TO  35 

0110 

90 

IF  (ABSCDl)  .GE.  SIXTH)  GO  TO  95 

0112 

D 1  =  D 1*SIXTN 

0113 

D2  =  D2-F0UR 

0114 

GO  TO  90 

0115 

95 

CONTINUE 

0116 

JP1  =  J+l 

0117 

IF  (JP1  .GT.  N)  GO  TO  105 

C 

DIVIDE  BY  PIVOT  ELEMENT  U(J,J) 

0119 

P  =  ALUCJ.J) 

0120 

DO  100  I=JP1,N 

0121 

ALU(I.J)  =  ALU( I, J)XP 

0122 

100 

CONTINUE 

0123 

105 

CONTINUE 
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C 

PERFORM  ACCURACY  TEST 

0124 

IF  CIDGT  .EQ.  0)  GO  TO  9005 

0126 

P  =  3*N-:-3 

0127 

UA  =  P-HJREL 

3128 

IF  (I.JA+10.-!"K<-IDGT:i  .HE.  UA) 

GO  TO  9005 

0130 

IER  =  34 

3131 

c 

GO  TO  9030 

ALGORITHMIC  SINGULARITY 

0132 

110 

IER  =  129 

0133 

D 1  =  ZERO 

0134 

D2  =  ZERO 

0135 

9000 

CONTINUE 

C 

PRINT  ERROR 

0136 

D 

CALL  UERTSTC IER.6HLUDATF) 
STOP 

0137 

c 

9005 

RETURN 

0138 

END 

97 
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NAME 

OFFSET 

ATTRIBUTES 

A 

000014 

REALM 

PARAMETER 

ARRAY  (IA, I) 

IA 

30O022 

INTEGERS 

PARAMETER 

VARIABLE 

ALU 

003016 

REALM 

PARAMETER 

ARRAY  (IA, 1) 

I  PVT 

000032 

INTEGERS 

PARAMETER 

ARRAY  (1) 

EGUIL 

000034 

REALM 

PARAMETER 

ARRAY  (1) 

N 

000020 

INTEGERS 

PARAMETER 

VARIABLE 

IDGT 

000024 

INTEGERS 

PARAMETER 

VARIABLE 

D1 

000026 

REALM 

PARAMETER 

VARIABLE 

D2 

000030 

REALM 

PARAMETER 

VARIABLE 

UA 

000036 

REALM 

PARAMETER 

VARIABLE 

IER 

00C040 

INTEGERS 

PARAMETER 

VARIABLE 

ZERO 

000042 

REALM 

VARIABLE 

ONE 

000046 

REALM 

VARIABLE 

FOUR 

000052 

REALM 

VARIABLE 

3IXTN 

000056 

REALM 

VARIABLE 

SIXTH 

000062 

REALM 

VARIABLE 

RN 

000076 

REALM 

VARIABLE 

UREL 

000102 

REALM 

VARIABLE 

BIGA 

000106 

REALM 

VARIABLE 

I 

000112 

INTEGERS 

VARIABLE 

BIG 

000114 

REALM 

VARIABLE 

J 

000120 

INTEGERS 

VARIABLE 

P 

000122 

REALM 

VARIABLE 

ABS 

000000 

REALM 

PROCEDURE 

JM1 

000126 

INTEGERS 

VARIABLE 

SUM 

000130 

REALM 

VARIABLE 

IM1 

000134 

INTEGER*2 

VARIABLE 

A I 

000136 

REALM 

VARIABLE 

UI 

000142 

REALM 

VARIABLE 

K 

000146 

INTEGERS 

VARIABLE 

T 

000150 

REALM 

VARIABLE 

TEST 

000154 

REALM 

VARIABLE 

Q 

000160 

REALM 

VARIABLE 

I  MAX 

000164 

INTEGERS 

VARIABLE 

JP1 

000166 

INTEGERS 

VARIABLE 

UERTST 

000000 

REALM 

PROCEDURE 

a  u 
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PURPOSE  -  ELIMINATION  PART  OF  SOLUTION  OF  AX»B 

(FULL  STORAGE  MODE) 

USAGE  -  CALL  LUELMF  (A,B, IPVT,N, IA.X) 

ARGUMENTS  A  -  A  =  LU  (THE  RESULT  COMPUTED  IN  THE  IMSL 

ROUTINE  LUDATF)  WHERE  L  IS  A  LOWER 
TRIANGULAR  MATRIX  WITH  ONES  ON  THE  MAIN 
DIAGONAL.  U  IS  UPPER  TRIANGULAR.  L  AND  U 
ARE  STORED  AS  A  SINGLE  MATRIX  A  AND  THE 
UNIT  DIAGONAL  OF  L  IS  NOT  STORED.  (INPUT) 

B  -  B  IS  A  VECTOR  OF  LENGTH  N  ON  THE  RIGHT  HAND 

SIDE  OF  THE  EQUATION  AX»B.  (INPUT) 

I PVT  -  THE  PERMUTATION  MATRIX  RETURNED  FROM  THE 

IMSL  ROUTINE  LUDATF,  STORED  AS  AN  N  LENGTH 
VECTOR.  (INPUT) 

N  -  ORDER  OF  A  AND  NUMBER  OF  ROWS  IN  B.  (INPUT) 

I A  -  ROW  DIMENSION  OF  A  EXACTLY  AS  SPECIFIED  IN 

THE  DIMENSION  STATEMENT  IN  THE  CALLING 
PROGRAM.  (INPUT) 

-  THE  RESULT  X.  (OUTPUT) 
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0001 

0002 


0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 

0012 

0013 

0014 

0015 

0016 

0017 

0019 

0020 

0021 

0022 

0023 

0024 

0026 

0027 

0028 

0029 

0030 

0031 


SUBROUTINE  LUELMF  (A.B. IPVT,N. IA.X) 

DIMENSION  ACIA.  1).3(1),  IPVTU).X(l) 

FIRST  EXECUTABLE  STATEMENT 
SOLVE  LY  =  B  FOR  Y 

DO  5  1=1, N 
5  >«I)  =  3(1) 

ID  =  0 
DO  20  1=1, N 
IP  =  IPVT(I) 

SUM  =  X(IP) 

XC1P)  =  X(I) 

IF  (IU  .EQ.  0)  GO  TO  15 
IM1  «  1-1 
DO  10  J=UJ,  IM1 

SUM  =  SUM-A(I,J)*X(J) 

10  CONTINUE 

GO  TO  20 

15  IF  (SUM  ,NE.  0.)  IU  =  I 

20  X(I)  =  SUM 

SOLVE  UX  =  Y  FOR  X 

DO  30  IB=1,N 
I  =  N+l-IB 
IP1  =  1+1 
SUM  =  X(I) 

IF  (IP1  .GT.  N)  GO  TO  38 
DO  25  J«IP1,N 

SUM  =  SUM-A(I,J)*X(J) 

25  CONTINUE 
30  X(I)  =  SUM/A (1,1) 

RETURN 

END 


Ml DAS  FORTRAN  IV  STORAGE  MAP 


NAME  OFFSET  ATTRIBUTES 

A  000014  REAL *4  PARAMETER  ARRAY  CIA,  15 

IA  000024  INTEGERS  PARAMETER  VARIABLE 

B  300016  REALM  PARAMETER  ARRAY  <D 

I PVT  000029  INTEGERS  PARAMETER  ARRAY  (1) 

X  000026  REAL*4  PARAMETER  ARRAY  (1) 

N  000022  INTEGERS  PARAMETER  VARIABLE 

I  000030  INTEGERS  VARIABLE 

IU  000032  INTEGERS  VARIABLE 

IP  000034  INTEGERS  VARIABLE 

SUM  000036  REAL*4  VARIABLE 

IM1  000042  INTEGERS  VARIABLE 

J  000044  INTEGERS  VARIABLE 

IB  000046  INTEGERS  VARIABLE 

IP1  000050  INTEGERS  VARIABLE 
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IMSL  ROUTINE  NAME 


COMPUTER 
LATEST  REVISION 
PURPOSE 
USAGE 

ARGUMENTS  IER 


NAME 


-  UERTST 


-  ND  6620 

-  MAY  1981  BY  G.W.P. 

-  PRINT  A  MESSAGE  REFLECTING  AN  ERROR  CONDITION 

-  CALL  UERTST  ( IER, NAME) 

-  ERROR  PARAMETER.  (INPUT) 

IER  =  I+J  WHERE 

1-120  IMPLIES  TERMINAL  ERROR. 

I  =  64  IMPLIES  WARNING  WITH  FIX,  AND 

I  =  32  IMPLIES  WARNING. 

J  =  ERROR  CODE  RELEVANT  TO  CALLING 
ROUTINE. 

-  A  SIX  CHARACTER  LITERAL  STRING  GIVING  THE 

NAME  OF  THE  CALLING  ROUTINE.  (INPUT) 
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C 


01 

SUBROUTINE  UERTST  ( IER, NAME) 

C 

SPECIFICATIONS  FOR  ARGUMENTS 

02 

INTEGER 

IER 

03 

INTEGERS 

NAME (3) 

r 

SPECIFICATIONS  FOR  LOCAL  VARIABLE: 

04 

IN' 

fEGER*2 

NAMSET (3) , MAMEQ (3) 

05 

DATA 

I DUN  IT/7/ 

06 

DATA 

NAMSET/2HUE, 2HRS , 2HET/ 

i07 

DATA 

NAMEG/2H  .2H  ,2H  / 

C 

FIRST  EXECUTABLE  STATEMENT 

108 

DATA 

LEVEL/4/, IEQDF/0/, IEQ/1H=/ 

199 

IF 

( IER. GT. 999) 

GO  TO  25 

111 

IF 

(IER. LT. -323 

GO  TO  55 

113 

IF 

(IER.LE. 128) 

GO  TO  5 

>15 

IF 

(LEVEL.LT. 1) 

GO  TO  30 

C 

PRINT  TERMINAL  MESSAGE 

317 

IF 

( IEQDF.EQ. 1) 

UR ITE ( IOUN IT, 35)  IER.NAMEQ. IEQ.NAME 

319 

IF 

( IEQDF.EQ.0) 

URITE ( IOUN IT, 35)  IER, NAME 

321 

GO 

TO  30 

322 

5 

IF 

(IER.LE. 64) 

GO  TO  10 

324 

IF 

(LEVEL.LT. 2) 

GO  TO  30 

c 

PRINT  UARNING  UITH  FIX  MESSAGE 

326 

IF 

(IEQDF.EQ. 1) 

UR  I Tc ( I OUN I T, 40 )  IER.NAMEQ, IEQ.NAME 

328 

IF 

(IEQDF.EQ.0) 

URITEdOUNIT, 40)  IER, NAME 

330 

GO 

TO  30 

331 

10 

IF 

(IER.LE. 32) 

GO  TO  15 

c 

PRINT  UARNING  MESSAGE 

033 

IF 

(LEVEL.LT. 3) 

GO  TO  30 

035 

IF 

(IEQDF.EQ. 1) 

URITEdOUNIT, 45)  IER.NAMEQ.  IEQ.NAME 

037 

IF 

(IEQDF.EQ.0) 

URITE (I0UNIT.45)  IER, NAME 

039 

GO 

TO  30 

040 

15 

CONTINUE 

c 

CHECK  FOR  UERSET  CALL 

941 

DO 

20  1=1.3 

042 

IF  (NAME ( I ) . NE . NAMSET ( I) )  GO  TO  25 

044 

20 

CONTINUE 

045 

LEVOLD  =  LEVEL 

046 

LEVEL  =  IER 

047 

IER  =  LEVOLD 

048 

IF 

(LEVEL. LT.0) 

LEVEL  =  4 

050 

IF 

(LEVEL.GT.4) 

LEVEL  =  4 

052 

GO 

TO  30 

053 

25 

CONTINUE 

054 

IF 

(LEVEL.LT. 4) 

GO  TO  30 

ifis  FORTRAN  IV 
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C 

56 

iS 

50 

51 

52 

53 

54 

55 

C 

C 

c 

5b 

5? 

S3 

S9 

?0 


PRINT  NON-DEFINED  MESSAGE 

IF  < IEQDF.EQ. 1)  UR ITE( IOUNIT,50)  IER, NAMED, IEQ,NAME 
IF  ( IEQDF.EQ. 0)  URITE( IOUNIT,50)  IER. NAME 
30  IEQDF  =  O 
RETURN 

35  FORMAT USH  *w*  TERMINAL  ERROR, 10X, 7H( IER  =  ,13, 

1  29H>  FROM  IMSL  ROUTINE  , 3A2, A 1 , 3A2) 

40  FORMAT C3SH  :**;’<  WARNING  WITH  FIX  ERROR  (IER  =  ,13, 
i  23H:»  FROM  IMSL  ROUTINE  ,3A2,A1,3A2) 

45  FORMAT ( 18H  ***  WARNING  ERROR, 1 IX, ?H (IER  =  ,13, 

1  20H)  FROM  IMSL  ROUTINE  , 3A2, A 1 , 3A2) 

50  FORMAT (20H  ***  UNDEFINED  ERROR, 9X, 7H ( IER  =  ,15. 

1  20H)  FROM  IMSL  ROUTINE  ,3A2,A1,3A2) 

SAVE  P  FOR  P  =  R  CASE 
P  IS  THE  PAGE  NAME 
R  IS  THE  ROUTINE  NAME 

55  IEQDF  =  1 
DO  60  1=1,3 
60  NAMEQCI)  =  NAME ( I ) 

65  RETURN 
END 


104 


STORAGE  MAP 


Mi: A”  FORTRAN  I' 

STORAGE 

:  map 

NAME 

OFFSET 

ATTRIBUTES 

NAME 

000016 

INTEGERS 

PARAMETER 

ARRAY  (3) 

NAMSET 

000020 

INTEGERS 

ARRAY  (3) 

NAMEQ 

000826 

INTEGER *2 

ARRAY  (31 

IER 

000014 

INTEGERS 

PARAMETER 

VARIABLE 

IOUNIT 

000034 

INTEGERS 

VARIABLE 

LEVEL 

0GIJ  036 

INTEGERS 

VARIABLE 

IEQDF 

000040 

INTEGERS 

VARIABLE 

IEQ 

008042 

INTEGERS 

VARIABLE 

I 

000460 

INTEGERS 

VARIABLE 

LEVOLD 

000462 

INTEGERS 

VARIABLE 

nnnnnnnonnnnonnnnnnnonnnnnnnonnonnonor) 
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IMSL  ROUTINE  NAME  -  VMULFF 


C0MP"TER 


ND  6620 


LATEST  REVISION 


MAY  193!  3Y  G.U.P. 


PURPOSE 


MATRIX  MULTIPLICATION  (FULL  STORAGE  MODE) 


USAGE 


CALL  VMULFF  (A,B,L,M,N. IA, IB,C, IC, IER) 


ARGUMENTS  A 

B 

L 

M 

N 

IA 


IB 


C 

IC 


IER 


L  BY  M  MATRIX  STORED  IN  FULL  STORAGE  MODE. 
(INPUT) 

M  BY  N  MATRIX  STORED  IN  FULL  STORAGE  MODE. 
(INPUT) 

NUMBER  OF  ROUS  IN  A.  (INPUT) 

NUMBER  OF  COLUMNS  IN  A  (SAME  AS  NUMBER  OF 
ROUS  IN  B).  (INPUT) 

NUMBER  OF  COLUMNS  IN  B.  (INPUT) 

ROU  DIMENSION  OF  MATRIX  A  EXACTLY  AS 

SPECIFIED  IN  THE  DIMENSION  STATEMENT  IN  THE 
CALLING  PROGRAM.  (INPUT) 

ROU  DIMENSION  OF  MATRIX  B  EXACTLY  AS 

SPECIFIED  IN  THE  DIMENSION  STATEMENT  IN  THE 
CALLING  PROGRAM.  (INPUT) 

L  BY  N  MATRIX  CONTAINING  THE  PRODUCT 
C  =  A*B.  (OUTPUT) 

ROU  DIMENSION  OF  MATRIX  C  EXACTLY  AS 

SPECIFIED  IN  THE  DIMENSION  STATEMENT  IN  THE 
CALLING  PROGRAM.  (INPUT) 

ERROR  PARAMETER.  (OUTPUT) 

TERMINAL  ERROR 

IER=123  INDICATES  A,B,OR  C  UAS  DIMENSIONED 
INCORRECTLY. 


REQD.  IMSL  ROUTINES  -  UERTST 
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0001 

c 

SUBROUTINE  VMULFF  (A.B.L 

C 

3002 

INTEGER  L,M,N 

3003 

.. 

REAL  M  A ( IA, M3 , B(IS,N) 

0004 

DOUBLE  PRECISION  TEMP 

c 

0005 

IF  (IA  .GE.  L  .AND.  13  .1 

0007 

l# 

I£R= 129 

0008 

c 

GO  TO  9008 

0009 

5 

IER  =  0 

0010 

c 

DO  15  I  =  1 , L 

0011 

DO  15  J  =  1 ,  N 

0012 

c 

TEMP =0.0 

0013 

DO  10  K=  1 ,  M 

0014 

temp*a(I.k)*b(k 

0015 

10 

CONTINUE 

0016 

C(  1, J) *TEMP 

0017 

15 

CONTINUE 

0O18 

GO  TO  9805 

0019 

9000 

continue 

0020 

CALL  UERTST  ( IER, 6HVMULF! 

0021 

9005 

RETURN 

SPECIFICATIONS  FOR  ARGUMENTS 
IS, IC, IER 
:,n) 

SPECIFICATIONS  FOR  LOCAL  VARIABLE 

FIRST  EXECUTABLE  STATEMENT 
1  .AND.  IC  .GE.  L)  GO  TO  5 
TERMINAL  ERROR 

ROU  INDICATOR 

COLUMN  INDICATOR 

VECTOR  DOT  PRODUCT 


MIDAS  FORTRAN  IV  STORAGE  MAP 


NAME 

OFFSET 

ATTRIBUTES 

A 

000314 

REAL*4 

PARAMETER 

ARRAY  (IA 

IA 

030026 

INTEGERS 

PARAMETER 

VARIABLE 

M 

590022 

INTEGERS 

PARAMETER 

VARIABLE 

3 

0000! 6 

REAL*4 

PARAMETER 

ARRAY  (IB 

IB 

000030 

INTEGERS 

PARAMETER 

VARIABLE 

N 

000024 

INTEGERS 

PARAMETER 

VARIABLE 

C 

000032 

REAL*4 

PARAMETER 

ARRAY  (IC 

IC 

000034 

INTEGERS 

PARAMETER 

VARIABLE 

L 

000020 

INTEGERS 

PARAMETER 

VARIABLE 

IER 

000036 

INTEGERS 

PARAMETER 

VARIABLE 

TEMP 

000050 

REALMS 

VARIABLE 

I 

000060 

INTEGERS 

VARIABLE 

J 

000062 

INTEGERS 

VARIABLE 

K 

000064 

INTEGERS 

VARIABLE 

UERTST 

000000 

REAL*4 
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C  IMSL  ROUTINE  NAME  -  VMULFP 
C 

r - 


COMPUTER 


-  MD6629 


LATEST  REVISION 


-  MAY  1931  BY  G.U.P. 


PURPOSE 


MATRIX  MULTIPLICATION  OF  MATRIX  A  BY  THE 
TRANSPOSE  OF  MATRIX  B  (FULL  STORAGE  MODE) 


USAGE 


CALL  VMULFP  (A,B,L,M,N, IA, IB.C, IC, IER) 


ARGUMENTS  A 

B 

L 

M 

N 

IA 


IB 


C 

IC 


IER 


REGD.  IMSL  ROUTINES  - 


L  BY  M  MATRIX  STORED  IN  FULL  STORAGE  MODE. 
(INPUT) 

N  BY  M  MATRIX  STORED  IN  FULL  STORAGE  MODE. 

< INPUT) 

NUMBER  OF  ROUS  IN  A  AND  C.  (INPUT) 

NUMBER  OF  COLUMNS  IN  A  AND  B.  (INPUT) 

NUMBER  OF  ROUS  IN  MATRIX  B  AND  NUMBER  OF 
COLUMNS  IN  MATRIX  C.  (INPUT) 

ROU  DIMENSION  OF  MATRIX  A  EXACTLY  AS 

SPECIFIED  IN  THE  DIMENSION  STATEMENT  IN  THE 
CALLING  PROGRAM.  (INPUT) 

ROU  DIMENSION  OF  MATRIX  B  EXACTLY  AS 

SPECIFIED  IN  THE  DIMENSION  STATEMENT  IN  THE 
CALLING  PROGRAM.  (INPUT) 

L  BY  N  MATRIX  CONTAINING  THE  PRODUCT 
C  =  A ^8-TRANSPOSE.  (OUTPUT) 

ROU  DIMENSION  OF  MATRIX  C  EXACTLY  AS 

SPECIFIED  IN  THE  DIMENSION  STATEMENT  IN  THE 
CALLING  PROGRAM.  (INPUT) 

ERROR  PARAMETER. 

TERMINAL  ERROR 

IER= 129  INDICATES  A,B,OR  C  UAS  DIMENSIONED 
INCORRECTLY. 

UERTST 


C 
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C 


0001 

r 

SUBROUTINE  VMULFP  (A,B,L,M„N, IA, IB,C, IC, IER) 

0002 

L 

REAL*4  A(IA.M),B(IB,M),CCIC,N) 

c 

FIRST  EXECUTABLE  STATEMENT 

0003 

IF  < IA.GE.L  .AND.  IB.GE.N  .AND.  1C.GE.L)  GO  TO  5 

c 

TERMINAL  FRROR 

0005 

IER  =  129 

0006 

GO  TO  9000 

c 

ROW  INDICATOR 

000? 

5 

IER  =  0 

0008 

DO  20  1  -  1,L 

c 

COLUMN  INDICATOR 

0009 

DO  15  J  *  1„N 

0010 

TEMP  =0.0 

c 

VECTOR  DOT  PRODUCT 

0011 

DO  10  K  =  1 ,M 

0012 

TEMP  •  TEMP  +  A<I,K)*B(J,K) 

0013 

10 

CONTINUE 

0014 

C(I,J)  =  TEMP 

0015 

15 

CONTINUE 

0016 

20 

CONTINUE 

001? 

GO  TO  9005 

0018 

9000 

CONTINUE 

0019 

CALL  UERTST  ( IER.6HVMULFP) 

0020 

9005 

RETURN 

0021 

END 
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MIDAS  FORTRAN  IV  STORAGE  MAP 


NAME 

OFFSET 

ATTRIBUTES 

A 

009814 

REAL'i'4 

PARAMETER 

ARRAY  ( IA, M) 

IA 

080026 

INTEGERS 

PARAMETER 

VARIA3LE 

M 

000022 

INTEGERS 

PARAMETER 

VARIABLE 

B 

000016 

REAL *4 

PARAMETER 

ARRAY  ' IB.M) 

IB 

09G030 

INTEGERS 

PARAMETER 

VARIABLE 

C 

000032 

REAL*4 

PARAMETER 

ARRAY  ( IC.N) 

IC 

000034 

INTEGERS 

PARAMETER 

VARIABLE 

N 

000024 

INTEGERS 

PARAMETER 

VARIABLE 

L 

000020 

INTEGERS 

PARAMETER 

VARIABLE 

IER 

000036 

INTEGERS 

PARAMETER 

VARIABLE 

I 

00O050 

INTEGERS 

VARIABLE 

J 

000052 

INTEGERS 

VARIABLE 

TEMP 

000054 

REAL*4 

VARIABLE 

K 

000060 

INTEGERS 

VARIABLE 

UERTST 

000000 

REAL*4 

PROCEDURE 

END 

FILMED 

7-85 

DTIC 


